用perl写的一段小游戏(转贴)

黄叶

转自http://www.ilcatperl.org/

1. 
   
2. #!/usr/bin/perl -w
   
3. #!/usr/local/bin/perl -w
   
4. 
   
5. use strict;
   
6. use diagnostics;
   
7. use Tk;
   
8. use Tk::Dialog;
   
9. use Tk::After;
   
10. use Tk::ProgressBar;
    
11. #use Tk::Photo;
    
12. 
    
13. my $colorAvail = 0;
    
14. 
    
15. if (eval "require Tk::ColourChooser") {
    
16.   $colorAvail = 1;
    
17. }
    
18. 
    
19. # Constants
    
20. # 排行榜最大值
    
21. use constant MAXHIGH       => 11;
    
22. # 排行榜里名字的最大长度
    
23. use constant NAMECHARSMAX  => 20;
    
24. # 排行榜文件路径和名字
    
25. use constant HIGHSCOREFILE => "C:\\.cascadixHigh";
    
26. 
    
27. # 全局变量
    
28. my $rows                  = 8;  # ! 8  means 0 .. 8  = 9  rows   !
    
29. my $cols                  = 24; # ! 24 means 0 .. 24 = 25 columns!
    
30. my $offset                = 4;
    
31. my $colors                = 3;
    
32. my $searchMax             = 40;
    
33. my @cpreset1              = ( "tomato2", "LightGoldenrod2", "DeepSkyBlue1");
    
34. my @cpreset2              = ( "gray10", "gray50", "gray90");
    
35. my @cpreset3              = ( "blue", "green", "red");
    
36. my @color                 = @cpreset1;
    
37. my $sizeOfItems           = 15;
    
38. my $distanceBetweenItems  = 5;
    
39. my $form                  = 'rectangle';　　　　　　　　　　　　#'oval';
    
40. my $highscorefile         = tilde(HIGHSCOREFILE);
    
41. my $points                = 0;
    
42. my $undopoints            = 0;
    
43. my $i                     = 1;
    
44. my $name;
    
45. if ($^O =~ m/Win/) {
    
46.   $name = "HansWurst";
    
47. }
    
48. else {
    
49.   $name = getpwuid($<);
    
50. }
    
51. my $delta;
    
52. my $gameSizex;
    
53. my $gameSizey;
    
54. my $markcolor;
    
55. 
    
56. # widgets
    
57. my $top;
    
58. my $highW;
    
59. my $canvas;
    
60. my $cProgBar0;
    
61. my $cProgBar1;
    
62. my $cProgBar2;
    
63. my $undoB;
    
64. 
    
65. my $marked;
    
66. my $x;
    
67. my $y;
    
68. my $n;
    
69. my $j;
    
70. 
    
71. # 数组的数组:这是包含条目的二维数组
    
72. my @lol;
    
73. # 为了取消删除@lol的一个拷贝
    
74. my @lolcopy;
    
75. 
    
76. my @colorlist;
    
77. my $nrcolor0;
    
78. my $nrcolor1;
    
79. my $nrcolor2;
    
80. my $cmax;
    
81. my $cmin;
    
82. 
    
83. # 散列的数组
    
84. my @highscore;
    
85. 
    
86. # 主程序
    
87. 
    
88. fillLol();
    
89. 
    
90. mainWin();
    
91. 
    
92. readHigh();
    
93. 
    
94. paintItems();
    
95. 
    
96. $top->MainLoop;
    
97. 
    
98. # 子程序
    
99. 
    
100. my $rep = 0;
     
101. sub fillLol {
     
102. 
     
103.   $rep = 0;
     
104.   while (1) {
     
105. 　　　　@lol = ();
     
106. 　　　　my $color;
     
107. 
     
108. 　　　　@colorlist = ();
     
109. 　　　　for (0 .. 2) { $colorlist[$_] = 0; }
     
110. 
     
111. 　　　　for $x (0 .. $cols) {
     
112. 　　　　  for $y (0 .. $rows) {
     
113. 　　　　　　　　# 选择一个任意颜色
     
114. 　　　　　　　　$color = int(rand 3) + 1;
     
115. 　　　　　　　　# fill the two dimensional array with the color
     
116. 　　　　　　　　$lol[$x][$y] = $color;
     
117. 　　　　　　　　# increase the counter for this color
     
118. 　　　　　　　　$colorlist[$color - 1]++;
     
119. 　　　　  }
     
120. 　　　　}
     
121. 
     
122. 　　　　$cmin = 20;
     
123. 　　　　$cmax = 60;
     
124. 
     
125. 　　　　# number of blocks
     
126. 　　　　my $blocks = ($cols + 1)*($rows + 1);
     
127. 
     
128. 　　　　# round and calculate the percentage of the colors
     
129. 　　　　$nrcolor0 = sprintf "%.0f", $colorlist[0]/$blocks*100;
     
130. 　　　　$nrcolor1 = sprintf "%.0f", $colorlist[1]/$blocks*100;
     
131. 　　　　$nrcolor2 = sprintf "%.0f", $colorlist[2]/$blocks*100;
     
132. 
     
133. 　　　　# exit loop when a criteria is met
     
134. 　　　　last if ($nrcolor0 >= $searchMax or
     
135. 　　　　　　　　　　　　 $nrcolor1 >= $searchMax or
     
136. 　　　　　　　　　　　　 $nrcolor2 >= $searchMax or
     
137. 　　　　　　　　　　　　 $rep >= 1000);
     
138. 
     
139. 　　　　$rep++;
     
140.   }
     
141.   #print "searched $rep times\n";
     
142. }
     
143. 
     
144. # sub printlol {
     
145. #   my $text = shift;
     
146. #   my $listRef = shift;
     
147. #   print "$rows $cols $text ------------------------\n";
     
148. #   for ($x = $rows; $x >= 0; $x--) {
     
149. # 　　　　for $y ( 0 .. $cols) {
     
150. # 　　　　  if ( $$listRef[$y][$x] ) {
     
151. # 　　　　　　　　if ( $$listRef[$y][$x] == $markcolor) {
     
152. # 　　　　　　　　  print "* ";
     
153. # 　　　　　　　　} else {
     
154. # 　　　　　　　　  print $$listRef[$y][$x]," ";
     
155. # 　　　　　　　　}
     
156. # 　　　　  } else {
     
157. # 　　　　　　　　print "- ";
     
158. # 　　　　  }
     
159. # 　　　　}
     
160. # 　　　　print "\n";
     
161. #   }
     
162. #   print "------------------------\n";
     
163. # }
     
164. 
     
165. # sub printcolor {
     
166. 
     
167. #   print "------------------------\n";
     
168. #   for ($x = 0; $x <= 2; $x++) {
     
169. # 　　　　print "$x $color[$x] $colorlist[$x]\n";
     
170. #   }
     
171. #   print "------------------------\n";
     
172. # }
     
173. 
     
174. sub markIt {
     
175.   my $x     = shift;
     
176.   my $y     = shift;
     
177.   my $color = shift;
     
178. 
     
179.   # mark this item with the markcolor
     
180.   $lol[$x][$y] = $markcolor;
     
181.   # count the marked items
     
182.   $marked++;
     
183. 
     
184.   plopItem($x, $y);
     
185. 
     
186.   # look top
     
187.   if ($y < $rows) {
     
188. 　　　　if ($lol[$x][$y+1]) {
     
189. 　　　　  if ($lol[$x][$y+1] == $color) {
     
190. 　　　　　　　　markIt($x, $y+1, $color);
     
191. 　　　　  }
     
192. 　　　　}
     
193.   }
     
194.   # look right
     
195.   if ($x < $cols) {
     
196. 　　　　if ($lol[$x+1][$y]) {
     
197. 　　　　  if ($lol[$x+1][$y] == $color) {
     
198. 　　　　　　　　markIt($x+1, $y, $color);
     
199. 　　　　  }
     
200. 　　　　}
     
201.   }
     
202.   # look down
     
203.   if ($y > 0) {
     
204. 　　　　if ($lol[$x][$y-1]) {
     
205. 　　　　  if ($lol[$x][$y-1] == $color) {
     
206. 　　　　　　　　markIt($x, $y-1, $color);
     
207. 　　　　  }
     
208. 　　　　}
     
209.   }
     
210.   # look left
     
211.   if ($x > 0) {
     
212. 　　　　if ($lol[$x-1][$y]) {
     
213. 　　　　  if ($lol[$x-1][$y] == $color) {
     
214. 　　　　　　　　markIt($x-1, $y, $color);
     
215. 　　　　  }
     
216. 　　　　}
     
217.   }
     
218. 
     
219. }
     
220. 
     
221. sub removeMarked {
     
222. 
     
223.   my $i;
     
224.   my $j;
     
225.   my $aref;
     
226. 
     
227.   # from left to right
     
228.   for $i ( 0 .. $cols) {
     
229. 　　　　# and top down
     
230. 　　　　for ($j = $rows; $j >= 0; $j-- ) {
     
231. 　　　　  if ($lol[$i][$j]) {　　　　　　　　# if element exists
     
232. 　　　　　　　　if ($lol[$i][$j] == $markcolor) { # and its marked
     
233. 　　　　　　　　  splice @{ $lol[$i] }, $j, 1; # cut it out
     
234. 　　　　　　　　}
     
235. 　　　　  }
     
236. 　　　　}
     
237.   }
     
238. 
     
239.   # from right to left
     
240.   for ($i = $cols; $i >= 0; $i--) {
     
241. 　　　　my @array = @{ $lol[$i] };　　　　# @array is a colunm of @lol
     
242. 　　　　my $sum = 0;
     
243. 　　　　foreach (@array) {
     
244. 　　　　  $sum += $_ if (defined($_));
     
245. 　　　　}　　　　　　　　　　　　　　　　　　　　　　　　　　　　# buid the sum of all elements in col $i
     
246. 　　　　if ($sum <= 0) {　　　　　　　　　　　　# if this col is empty
     
247. 　　　　  splice @lol, $i, 1;　　　　　　　　# cut it out of @lol
     
248. 　　　　}
     
249.   }
     
250. }
     
251. 
     
252. sub paintItems {
     
253. 
     
254.   my ($x, $y, $col, $id);
     
255.   removeMarked();
     
256.   $canvas->delete('all');
     
257.   for $x (0 .. $cols) {
     
258. 　　　　for $y (0 .. $rows) {
     
259. 　　　　  if ($lol[$x][$y]) {
     
260. 　　　　　　　　if ($lol[$x][$y] > 0) {
     
261. 　　　　　　　　  my $col = $color[$lol[$x][$y]-1];
     
262. 　　　　　　　　  #my $tag = "item-$x-$y";
     
263. 　　　　　　　　  my $id = $canvas->create($form,
     
264. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　   ($x*$delta + $offset),
     
265. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　   ($gameSizey - ($y*$delta)),
     
266. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　   ($x*$delta + $sizeOfItems + $offset),
     
267. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　   ($gameSizey - ($y*$delta + $sizeOfItems)),
     
268. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　   -fill => $col,
     
269. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　  );
     
270. 
     
271. 　　　　　　　　  $canvas->bind($id,'<Button-1>',
     
272. 　　　　　　　　　　　　　　　　　　　　　　　　sub {
     
273. 　　　　　　　　　　　　　　　　　　　　　　　　  my $i;
     
274. 　　　　　　　　　　　　　　　　　　　　　　　　  my @coor = $canvas->coords($id);
     
275. 　　　　　　　　　　　　　　　　　　　　　　　　  my $indexx = int($coor[0]/$delta);
     
276. 　　　　　　　　　　　　　　　　　　　　　　　　  my $indexy = $rows - int($coor[1]/$delta);
     
277. 　　　　　　　　　　　　　　　　　　　　　　　　  $marked = 0;
     
278. 
     
279. 　　　　　　　　　　　　　　　　　　　　　　　　  # remember the color
     
280. 　　　　　　　　　　　　　　　　　　　　　　　　  my $color = $lol[$indexx][$indexy];
     
281. 
     
282. 　　　　　　　　　　　　　　　　　　　　　　　　  # remember the array for undo action
     
283. 　　　　　　　　　　　　　　　　　　　　　　　　  copyArray(\@lol, \@lolcopy);
     
284. 　　　　　　　　　　　　　　　　　　　　　　　　  $undoB->configure(-state => "normal");
     
285. 　　　　　　　　　　　　　　　　　　　　　　　　  markIt($indexx, $indexy, $color);
     
286. 　　　　　　　　　　　　　　　　　　　　　　　　  # if just found one, give him the color back and redraw all items
     
287. 　　　　　　　　　　　　　　　　　　　　　　　　  if ($marked <= 1) {
     
288. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　$lol[$indexx][$indexy] = $color;
     
289. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　paintItems();
     
290. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　return;
     
291. 　　　　　　　　　　　　　　　　　　　　　　　　  }
     
292. 　　　　　　　　　　　　　　　　　　　　　　　　  my $newPoints = 0;
     
293. 　　　　　　　　　　　　　　　　　　　　　　　　  for ($i = 1; $i <= $marked; $i++) {
     
294. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　$newPoints = $newPoints + $i;
     
295. 　　　　　　　　　　　　　　　　　　　　　　　　  }
     
296. 　　　　　　　　　　　　　　　　　　　　　　　　  $points = $points + $newPoints;
     
297. 　　　　　　　　　　　　　　　　　　　　　　　　  # remember the additional point for a undo move
     
298. 　　　　　　　　　　　　　　　　　　　　　　　　  $undopoints = $newPoints;
     
299. 　　　　　　　　　　　　　　　　　　　　　　　　  #removeMarked();
     
300. 　　　　　　　　　　　　　　　　　　　　　　　　  paintItems();
     
301. 　　　　　　　　　　　　　　　　　　　　　　　　  if (reachedEnd()) {
     
302. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　eog();
     
303. 　　　　　　　　　　　　　　　　　　　　　　　　  }
     
304. 　　　　　　　　　　　　　　　　　　　　　　　　});
     
305. 　　　　　　　　}
     
306. 　　　　  }
     
307. 　　　　}
     
308.   }
     
309. 
     
310. }
     
311. 
     
312. sub reachedEnd {
     
313. 
     
314.   my ($x, $y, $found);
     
315. 
     
316.   if (!$lol[0][0]) {
     
317. 　　　　# cleaned everything up!
     
318. 　　　　my $dialog =
     
319. 　　　　  $top->Dialog(-title => "Bonus",
     
320. 　　　　　　　　　　　　　　　　   -text => "太棒了!\n你清理干净了所有的目标!\n 奖励 500 点!",
     
321. 　　　　　　　　　　　　　　　　   -buttons => ["OK"]);
     
322. 　　　　$dialog->Show();
     
323. 　　　　$points = $points + 500;
     
324. 　　　　return 1;
     
325.   }
     
326. 
     
327.   $found = 0;
     
328.   for $x (0 .. $cols) {
     
329. 　　　　for $y (0 .. $rows) {
     
330. 　　　　  if ($lol[$x][$y]) {
     
331. 　　　　　　　　if ($lol[$x][$y] > 0 && $lol[$x][$y] < $markcolor) {
     
332. 　　　　　　　　  if (countIt($x, $y, $lol[$x][$y])) {
     
333. 　　　　　　　　　　　　$found++;
     
334. 　　　　　　　　　　　　last;
     
335. 　　　　　　　　  }
     
336. 　　　　　　　　}
     
337. 　　　　  } else {
     
338. 　　　　　　　　# we are searching bottom-up,
     
339. 　　　　　　　　# if there is nothing here there can`t be anything
     
340. 　　　　　　　　# in the higher positions
     
341. 　　　　　　　　#print "... is empty\n";
     
342. 　　　　　　　　last;
     
343. 　　　　  }
     
344. 　　　　  last if ($found > 0);
     
345. 　　　　}
     
346. 　　　　last if ($found > 0);
     
347.   }
     
348. 
     
349.   if ($found == 0) {
     
350. 　　　　return 1;
     
351.   } else {
     
352. 　　　　return 0;
     
353.   }
     
354. }
     
355. 
     
356. sub countIt {
     
357.   my $x     = shift;
     
358.   my $y     = shift;
     
359.   my $color = shift;
     
360. 
     
361.   # look top
     
362.   if ($y < $rows) {
     
363. 　　　　if ($lol[$x][$y+1]) {
     
364. 　　　　  if ($lol[$x][$y+1] == $color) {
     
365. 　　　　　　　　return 1;
     
366. 　　　　  }
     
367. 　　　　}
     
368.   }
     
369.   # look right
     
370.   if ($x < $cols) {
     
371. 　　　　if ($lol[$x+1][$y]) {
     
372. 　　　　  if ($lol[$x+1][$y] == $color) {
     
373. 　　　　　　　　return 1;
     
374. 　　　　  }
     
375. 　　　　}
     
376.   }
     
377.   # look down
     
378.   if ($y > 0) {
     
379. 　　　　if ($lol[$x][$y-1]) {
     
380. 　　　　  if ($lol[$x][$y-1] == $color) {
     
381. 　　　　　　　　return 1;
     
382. 　　　　  }
     
383. 　　　　}
     
384.   }
     
385.   # look left
     
386.   if ($x > 0) {
     
387. 　　　　if ($lol[$x-1][$y]) {
     
388. 　　　　  if ($lol[$x-1][$y] == $color) {
     
389. 　　　　　　　　return 1;
     
390. 　　　　  }
     
391. 　　　　}
     
392.   }
     
393.   return 0;
     
394. }
     
395. 
     
396. sub resetHigh {
     
397. 
     
398.   my $i;
     
399. 
     
400.   # reset highscore
     
401.   @highscore = ();
     
402. 
     
403.   # fill with default values
     
404.   for ($i = 0; $i < MAXHIGH; $i++) {
     
405. 　　　　my$rec = {};
     
406. 　　　　my $name = "John Doe";
     
407. 　　　　my $points = 0;
     
408. 　　　　$rec->{"name"} = $name;
     
409. 　　　　$rec->{"points"} = $points;
     
410. 　　　　push @highscore, $rec;
     
411.   }
     
412. 
     
413.   showHigh();
     
414. }
     
415. 
     
416. # sub printHigh {
     
417. 
     
418. #   my $i;
     
419. #   foreach (@highscore) {
     
420. # 　　　　$i++;
     
421. # 　　　　if ($_->{'name'}) {
     
422. # 　　　　  print "$i ".$_->{'name'}." ".$_->{'points'}."\n";
     
423. # 　　　　}
     
424. #   }
     
425. 
     
426. # }
     
427. 
     
428. sub showHigh {
     
429. 
     
430.   my $select = shift;
     
431.   $select = $select + 3 if $select;
     
432.   my $i;
     
433. 
     
434.   if (Exists($highW)) {
     
435. 　　　　$highW->withdraw();
     
436.   }
     
437. 
     
438.   # open window
     
439.   $highW = $top->Toplevel();
     
440. 
     
441.   $highW->title("Cascadix 排行榜");
     
442. 
     
443.   my $highlist =
     
444. 　　　　$highW->Scrolled("Listbox",
     
445. 　　　　　　　　　　　　　　　　　　　　 -scrollbars => 'osoe',
     
446. 　　　　　　　　　　　　　　　　　　　　 -selectmode => 'single',
     
447. 　　　　　　　　　　　　　　　　　　　　 -width => 36,
     
448. 　　　　　　　　　　　　　　　　　　　　 -height => 15)->pack(-expand => 1,
     
449. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　  -fill =>'both',
     
450. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　  -padx => 3,
     
451. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　  -pady => 3);
     
452. 
     
453.   my $OKB =
     
454. 　　　　$highW->Button(-text => "确定",
     
455. 　　　　　　　　　　　　　　　　   -command => sub {
     
456. 　　　　　　　　　　　　　　　　　　　　 $highW->withdraw();
     
457. 　　　　　　　　　　　　　　　　　　　　 return;
     
458. 　　　　　　　　　　　　　　　　   })->pack(-side => 'top',
     
459. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　-fill => 'x',
     
460. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　-padx => 3,
     
461. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　-pady => 3);
     
462. 
     
463.   $OKB->bind('<Return>',
     
464. 　　　　　　　　　　　　 sub {
     
465. 　　　　　　　　　　　　   $OKB->invoke;
     
466. 　　　　　　　　　　　　 }
     
467. 　　　　　　　　　　　　);
     
468. 
     
469.   $highlist->insert('end', "");
     
470.   $highlist->insert('end', "排名     名字                点数");
     
471.   $highlist->insert('end', "");
     
472. 
     
473.   foreach (@highscore) {
     
474. 　　　　$i++;
     
475. 　　　　if ($_->{'name'}) {
     
476. 　　　　  # the * is the placeholder for NAMECHARSMAX
     
477. 　　　　  my $line = sprintf " %3d. %-*s %6d", $i, NAMECHARSMAX, $_->{'name'}, $_->{'points'};
     
478. 　　　　  $highlist->insert('end', $line);
     
479. 　　　　}
     
480.   }
     
481. 
     
482.   if ($select) {
     
483. 　　　　$highlist->selectionSet($select);
     
484. 　　　　$highlist->see(0);
     
485. 　　　　$highlist->see($select);
     
486.   }
     
487. 
     
488.   $highW->waitWindow;
     
489. 
     
490. }
     
491. 
     
492. sub eog {
     
493. 
     
494.   # cut list to maxHigh
     
495.   splice @highscore, (MAXHIGH - 1);
     
496. 
     
497.   my $i = 0;
     
498.   my $inHigh = 0;
     
499. 
     
500.   foreach (@highscore) {
     
501. 　　　　if ($points > $_->{'points'}) {
     
502. 　　　　  $inHigh = 1;
     
503. 　　　　  last;
     
504. 　　　　}
     
505. 　　　　$i++;
     
506.   }
     
507. 
     
508.   if ($inHigh or ($i < MAXHIGH)) {
     
509. 　　　　insertPlayer($i);
     
510.   } else {
     
511. 　　　　my $dialog =
     
512. 　　　　  $top->Dialog(-title => "EOG: 游戏结束",
     
513. 　　　　　　　　　　　　　　　　   -text => "游戏结束\n$points 点.\n  这个成绩太差劲了.",
     
514. 　　　　　　　　　　　　　　　　   -buttons => ["再来一次!"]);
     
515. 　　　　$dialog->Show();
     
516.   }
     
517. 
     
518.   saveHigh();
     
519.   showHigh($i-1);
     
520. }
     
521. 
     
522. 
     
523. sub　　　　insertPlayer {
     
524. 
     
525.   my $i =shift;
     
526. 
     
527.   my $rc = getName($i+1);
     
528.   if ($rc eq "OK") {
     
529. 　　　　checkName(\$name);
     
530. 　　　　# cut off the second part and store it in highscoreTmp
     
531. 　　　　my @highscoreTmp = splice @highscore, $i;
     
532. 
     
533. 　　　　# insert a new DS
     
534. 　　　　my $rec = {};　　　　　　　　　　　　　　　　# record zuruecksetzten
     
535. 　　　　$rec->{'name'} = $name;
     
536. 　　　　$rec->{'points'} = $points;
     
537. 　　　　push @highscore, $rec;
     
538. 
     
539. 　　　　# add the highscoreTmp to highscore
     
540. 　　　　push @highscore, @highscoreTmp;
     
541.   }
     
542. }
     
543. 
     
544. sub readHigh {
     
545. 
     
546.   my ($field, $key, $value);
     
547. 
     
548.   if (! -f $highscorefile) {
     
549. 　　　　warn "readHigh: $highscorefile not found";
     
550. 　　　　resetHigh();
     
551. 　　　　#saveHigh();
     
552. 　　　　return;
     
553.   }
     
554. 
     
555.   if (!open(DATEI, "<$highscorefile")) {
     
556. 　　　　warn "readHigh: Can't open $highscorefile: $!\n";
     
557. 　　　　resetHigh();
     
558. 　　　　return;
     
559.   }
     
560. 
     
561.   # reset highscore list
     
562.   @highscore = ();
     
563. 
     
564. LINE: while (<DATEI>) {
     
565. 　　　　next LINE if /^$/;　　　　　　　　　　　　# Leerzeilen ueberspringen
     
566. 　　　　next LINE if /^#/;           # Kommentarzeilen ueberspringen
     
567. 　　　　my $rec;　　　　　　　　　　　　　　　　　　　　# record zuruecksetzten
     
568. 　　　　chomp;　　　　　　　　　　　　　　　　　　　　　　　　# removes the newlines from $_
     
569.   FIELD: for $field ( split /,/) {
     
570. 　　　　  ($key, $value) = split /=/, $field; # key und value trennen (=-Zeichen)
     
571. 
     
572. 　　　　  if ($rec->{$key}) {
     
573. 　　　　　　　　warn "$highscorefile Zeile: $.: Der key ($key) ist mehrfach vorhanden!";
     
574. 　　　　  }
     
575. 　　　　  $rec->{$key} = $value;
     
576. 　　　　}
     
577. 
     
578. 　　　　push @highscore, $rec;
     
579.   }
     
580. 
     
581.   close(DATEI);
     
582. 
     
583. }
     
584. 
     
585. sub saveHigh {
     
586. 
     
587.   if (!open(SAVEFILE, ">$highscorefile")) {
     
588. 　　　　warn "Can't open $highscorefile for write: $!\n";
     
589. 　　　　return 0;
     
590.   }
     
591. 
     
592.   #my $i;
     
593.   foreach ( @highscore ) {
     
594. 　　　　for my $key ( sort keys %{ $_ } ) {
     
595. 　　　　  print SAVEFILE "$key=$_->{$key},";
     
596. 　　　　}
     
597. 　　　　# Zeilenumbruch am Ende eines Datensatzes
     
598. 　　　　print SAVEFILE "\n";
     
599.   }
     
600. 
     
601.   if (!close(SAVEFILE)) {
     
602. 　　　　warn "error closing $highscorefile: $!\n";
     
603. 　　　　return 0;
     
604.   }
     
605.   return 1;
     
606. }
     
607. 
     
608. sub getName {
     
609. 
     
610.   my $p = shift;
     
611.   my $rc;
     
612. 
     
613.   # open window
     
614.   my $myDiag = $top->Toplevel();
     
615.   $myDiag->title("Game over");
     
616. 
     
617.   $myDiag->Label(-text => "你获得了 $points 点.\n恭喜你!\n你在排行榜里排名第 $p !\n请输入你的名字:",
     
618. 　　　　　　　　　　　　　　　　)->pack(-side => 'top',
     
619. 　　　　　　　　　　　　　　　　　　　　　　　　-fill => 'x',
     
620. 　　　　　　　　　　　　　　　　　　　　　　　　-padx => 3,
     
621. 　　　　　　　　　　　　　　　　　　　　　　　　-pady => 3);
     
622. 
     
623.   my $entry =
     
624. 　　　　$myDiag->Entry(-textvariable => \$name,
     
625. 　　　　　　　　　　　　　　　　   -width => 80,
     
626. 　　　　　　　　　　　　　　　　  )->pack(-side => 'top',
     
627. 　　　　　　　　　　　　　　　　　　　　　　　　  -fill => 'x',
     
628. 　　　　　　　　　　　　　　　　　　　　　　　　  -padx => 3,
     
629. 　　　　　　　　　　　　　　　　　　　　　　　　  -pady => 3);
     
630. 
     
631. 
     
632.   my $ButF =
     
633. 　　　　$myDiag->Frame()->pack(-fill =>'x',
     
634. 　　　　　　　　　　　　　　　　　　　　　　　　   -padx => 3,
     
635. 　　　　　　　　　　　　　　　　　　　　　　　　   -pady => 3);
     
636. 
     
637.   my $OKB =
     
638. 　　　　$ButF->Button(-text => "确定",
     
639. 　　　　　　　　　　　　　　　　  -command => sub {
     
640. 　　　　　　　　　　　　　　　　　　　　$rc = "OK";
     
641. 　　　　　　　　　　　　　　　　　　　　$myDiag->destroy();
     
642. 　　　　　　　　　　　　　　　　　　　　return "OK";
     
643. 　　　　　　　　　　　　　　　　  })->pack(-side => 'left',
     
644. 　　　　　　　　　　　　　　　　　　　　　　　　   -expand => 1,
     
645. 　　　　　　　　　　　　　　　　　　　　　　　　   -fill => 'x',
     
646. 　　　　　　　　　　　　　　　　　　　　　　　　   -padx => 3,
     
647. 　　　　　　　　　　　　　　　　　　　　　　　　   -pady => 3);
     
648. 
     
649.   $entry->bind('<Return>',
     
650. 　　　　　　　　　　　　   sub {
     
651. 　　　　　　　　　　　　　　　　 $OKB->invoke;
     
652. 　　　　　　　　　　　　   }
     
653. 　　　　　　　　　　　　  );
     
654. 
     
655.   $ButF->Button(-text => "取消",
     
656. 　　　　　　　　　　　　　　　　-command => sub {
     
657. 　　　　　　　　　　　　　　　　  $rc = "Cancel";
     
658. 　　　　　　　　　　　　　　　　  $myDiag->destroy();
     
659. 　　　　　　　　　　　　　　　　  return "Cancel";
     
660. 　　　　　　　　　　　　　　　　}
     
661. 　　　　　　　　　　　　   )->pack(-side => 'left',
     
662. 　　　　　　　　　　　　　　　　　　　　   -expand => 1,
     
663. 　　　　　　　　　　　　　　　　　　　　   -fill => 'x',
     
664. 　　　　　　　　　　　　　　　　　　　　   -padx => 3,
     
665. 　　　　　　　　　　　　　　　　　　　　   -pady => 3);
     
666. 
     
667.   $myDiag->waitWindow;
     
668.   return $rc;
     
669. 
     
670. }
     
671. 
     
672. ##############################################################
     
673. #
     
674. # tilde
     
675. #
     
676. ##############################################################
     
677. 
     
678. sub tilde {
     
679. 
     
680.   my $name = shift;
     
681. 
     
682.   return $name if ($^O =~ m/Win/);
     
683.   $name =~ s{ ^ ~ ( [^/]* ) }
     
684. 　　　　{ $1
     
685. 　　　　　　　　? (getpwnam($1))[7]
     
686. 　　　　　　　　  : ( $ENV{HOME} || $ENV{LOGDIR}
     
687. 　　　　　　　　　　　　  || (getpwuid($<))[7]
     
688. 　　　　　　　　　　　　)
     
689. 　　　　　　　　}ex;
     
690. 
     
691.   return $name;
     
692. }
     
693. 
     
694. sub display {
     
695. 
     
696.   my $distcopy   = $distanceBetweenItems;
     
697.   my $distcancel = $distanceBetweenItems;
     
698.   my $sizecopy   = $sizeOfItems;
     
699.   my $sizecancel = $sizeOfItems;
     
700.   my $formcopy   = $form;
     
701.   my $formcancel = $form;
     
702. 
     
703.   # open window
     
704.   my $displayW = $top->Toplevel();
     
705.   $displayW->title("显示选项");
     
706. 
     
707.   $displayW->Label(-text => "目标尺寸",
     
708. 　　　　　　　　　　　　　　　　  )->pack(-fill => 'x');
     
709. 
     
710.   $displayW->Scale(-variable => \$sizecopy,
     
711. 　　　　　　　　　　　　　　　　   -orient => 'horizontal',
     
712. 　　　　　　　　　　　　　　　　   -from => 5,
     
713. 　　　　　　　　　　　　　　　　   -to => 40,
     
714. 　　　　　　　　　　　　　　　　   -relief => 'raised'
     
715. 　　　　　　　　　　　　　　　　  )->pack(-fill   =>'x',
     
716. 　　　　　　　　　　　　　　　　　　　　　　　　  -expand => 1);
     
717. 
     
718.   $displayW->Label(-text => "目标间距",
     
719. 　　　　　　　　　　　　　　　　  )->pack(-fill => 'x');
     
720. 
     
721.   $displayW->Scale(-variable => \$distcopy,
     
722. 　　　　　　　　　　　　　　　　   -orient => 'horizontal',
     
723. 　　　　　　　　　　　　　　　　   -from => 1,
     
724. 　　　　　　　　　　　　　　　　   -to => 10,
     
725. 　　　　　　　　　　　　　　　　   -relief => 'raised'
     
726. 　　　　　　　　　　　　　　　　  )->pack(-fill   =>'x',
     
727. 　　　　　　　　　　　　　　　　　　　　　　　　  -expand => 1);
     
728. 
     
729.   $displayW->Label(-text => "目标形状",
     
730. 　　　　　　　　　　　　　　　　  )->pack(-fill => 'x');
     
731. 
     
732.   $displayW->Radiobutton(-text => "圆形",
     
733. 　　　　　　　　　　　　　　　　　　　　　　　　 -variable => \$formcopy,
     
734. 　　　　　　　　　　　　　　　　　　　　　　　　 -value => "oval")->pack(-fill =>'x');
     
735.   $displayW->Radiobutton(-text => "矩形",
     
736. 　　　　　　　　　　　　　　　　　　　　　　　　 -variable => \$formcopy,
     
737. 　　　　　　　　　　　　　　　　　　　　　　　　 -value => "rectangle")->pack(-fill =>'x');
     
738. 
     
739. 
     
740.   my $butF =
     
741. 　　　　$displayW->Frame(-relief => 'raised',
     
742. 　　　　　　　　　　　　　　　　　　　　 -borderwidth => 2)->pack(-side => 'left',
     
743. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　  -fill => 'x');
     
744. 
     
745.   $butF->Button(-text => "确定",
     
746. 　　　　　　　　　　　　　　　　-command => sub {
     
747. 　　　　　　　　　　　　　　　　  $distanceBetweenItems = $distcopy;
     
748. 　　　　　　　　　　　　　　　　  $form = $formcopy;
     
749. 　　　　　　　　　　　　　　　　  $sizeOfItems = $sizecopy;
     
750. 　　　　　　　　　　　　　　　　  mainWin();
     
751. 　　　　　　　　　　　　　　　　  paintItems();
     
752. 　　　　　　　　　　　　　　　　  $displayW->withdraw();
     
753. 　　　　　　　　　　　　　　　　}
     
754. 　　　　　　　　　　　　   )->pack(-side=>'left',
     
755. 　　　　　　　　　　　　　　　　　　　　   -fill =>'both');
     
756. 
     
757.   $butF->Button(-text => "应用",
     
758. 　　　　　　　　　　　　　　　　-command => sub {
     
759. 　　　　　　　　　　　　　　　　  $distanceBetweenItems = $distcopy;
     
760. 　　　　　　　　　　　　　　　　  $sizeOfItems = $sizecopy;
     
761. 　　　　　　　　　　　　　　　　  $form = $formcopy;
     
762. 　　　　　　　　　　　　　　　　  mainWin();
     
763. 　　　　　　　　　　　　　　　　  paintItems();
     
764. 　　　　　　　　　　　　　　　　}
     
765. 　　　　　　　　　　　　   )->pack(-side=>'left',
     
766. 　　　　　　　　　　　　　　　　　　　　   -fill =>'both');
     
767. 
     
768.   $butF->Button(-text => "取消",
     
769. 　　　　　　　　　　　　　　　　-command => sub {
     
770. 　　　　　　　　　　　　　　　　  $distanceBetweenItems = $distcancel;
     
771. 　　　　　　　　　　　　　　　　  $sizeOfItems = $sizecancel;
     
772. 　　　　　　　　　　　　　　　　  $form = $formcancel;
     
773. 　　　　　　　　　　　　　　　　  mainWin();
     
774. 　　　　　　　　　　　　　　　　  paintItems();
     
775. 　　　　　　　　　　　　　　　　  $displayW->withdraw();
     
776. 　　　　　　　　　　　　　　　　}
     
777. 　　　　　　　　　　　　   )->pack(-side=>'right',
     
778. 　　　　　　　　　　　　　　　　　　　　   -fill =>'both');
     
779. }
     
780. 
     
781. sub gameSize {
     
782. 
     
783.   my $rowscopy   = $rows + 1;
     
784.   my $colscopy   = $cols + 1;
     
785.   my $rowscancel = $rows;
     
786.   my $colscancel = $cols;
     
787. 
     
788.   # open window
     
789.   my $gameSizeW = $top->Toplevel();
     
790.   $gameSizeW->title("游戏尺寸");
     
791. 
     
792.   $gameSizeW->Label(-text => "行数:",
     
793. 　　　　　　　　　　　　　　　　   )->pack(-fill => 'x');
     
794. 
     
795.   $gameSizeW->Scale(-variable => \$rowscopy,
     
796. 　　　　　　　　　　　　　　　　　　　　-orient => 'horizontal',
     
797. 　　　　　　　　　　　　　　　　　　　　-from => 3,
     
798. 　　　　　　　　　　　　　　　　　　　　-to => 9,
     
799. 　　　　　　　　　　　　　　　　　　　　-relief => 'raised'
     
800. 　　　　　　　　　　　　　　　　   )->pack(-fill   =>'x',
     
801. 　　　　　　　　　　　　　　　　　　　　　　　　   -expand => 1);
     
802. 
     
803.   $gameSizeW->Label(-text => "列数:",
     
804. 　　　　　　　　　　　　　　　　   )->pack(-fill => 'x');
     
805. 
     
806.   $gameSizeW->Scale(-variable => \$colscopy,
     
807. 　　　　　　　　　　　　　　　　　　　　-orient => 'horizontal',
     
808. 　　　　　　　　　　　　　　　　　　　　-from => 3,
     
809. 　　　　　　　　　　　　　　　　　　　　-to => 25,
     
810. 　　　　　　　　　　　　　　　　　　　　-relief => 'raised'
     
811. 　　　　　　　　　　　　　　　　   )->pack(-fill   =>'x',
     
812. 　　　　　　　　　　　　　　　　　　　　　　　　   -expand => 1);
     
813. 
     
814.   my $butF =
     
815. 　　　　$gameSizeW->Frame(-relief => 'raised',
     
816. 　　　　　　　　　　　　　　　　　　　　  -borderwidth => 2)->pack(-side => 'left',
     
817. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　   -fill => 'x');
     
818. 
     
819.   $butF->Button(-text => "确定",
     
820. 　　　　　　　　　　　　　　　　-command => sub {
     
821. 　　　　　　　　　　　　　　　　  if ($rows != ($rowscopy - 1) or $cols != ($colscopy - 1)) {
     
822. 　　　　　　　　　　　　　　　　　　　　$rows = $rowscopy - 1;
     
823. 　　　　　　　　　　　　　　　　　　　　$cols = $colscopy - 1;
     
824. 　　　　　　　　　　　　　　　　　　　　fillLol();
     
825. 　　　　　　　　　　　　　　　　　　　　$points = 0;
     
826. 　　　　　　　　　　　　　　　　　　　　mainWin();
     
827. 　　　　　　　　　　　　　　　　　　　　paintItems();
     
828. 　　　　　　　　　　　　　　　　  }
     
829. 　　　　　　　　　　　　　　　　  $gameSizeW->withdraw();
     
830. 　　　　　　　　　　　　　　　　}
     
831. 　　　　　　　　　　　　   )->pack(-side=>'left',
     
832. 　　　　　　　　　　　　　　　　　　　　   -fill =>'both');
     
833. 
     
834.   $butF->Button(-text => "应用",
     
835. 　　　　　　　　　　　　　　　　-command => sub {
     
836. 　　　　　　　　　　　　　　　　  if ($rows != ($rowscopy - 1) or $cols != ($colscopy - 1)) {
     
837. 　　　　　　　　　　　　　　　　　　　　$rows = $rowscopy - 1;
     
838. 　　　　　　　　　　　　　　　　　　　　$cols = $colscopy - 1;
     
839. 　　　　　　　　　　　　　　　　　　　　fillLol();
     
840. 　　　　　　　　　　　　　　　　　　　　$points = 0;
     
841. 　　　　　　　　　　　　　　　　　　　　mainWin();
     
842. 　　　　　　　　　　　　　　　　　　　　paintItems();
     
843. 　　　　　　　　　　　　　　　　  }
     
844. 　　　　　　　　　　　　　　　　}
     
845. 　　　　　　　　　　　　   )->pack(-side=>'left',
     
846. 　　　　　　　　　　　　　　　　　　　　   -fill =>'both');
     
847. 
     
848.   $butF->Button(-text => "取消",
     
849. 　　　　　　　　　　　　　　　　-command => sub {
     
850. 　　　　　　　　　　　　　　　　  if ($rows != $rowscancel or $cols != $colscancel) {
     
851. 　　　　　　　　　　　　　　　　　　　　$rows = $rowscancel;
     
852. 　　　　　　　　　　　　　　　　　　　　$cols = $colscancel;
     
853. 　　　　　　　　　　　　　　　　　　　　fillLol();
     
854. 　　　　　　　　　　　　　　　　　　　　$points = 0;
     
855. 　　　　　　　　　　　　　　　　　　　　mainWin();
     
856. 　　　　　　　　　　　　　　　　　　　　paintItems();
     
857. 　　　　　　　　　　　　　　　　  }
     
858. 　　　　　　　　　　　　　　　　  $gameSizeW->withdraw();
     
859. 　　　　　　　　　　　　　　　　}
     
860. 　　　　　　　　　　　　   )->pack(-side=>'right',
     
861. 　　　　　　　　　　　　　　　　　　　　   -fill =>'both');
     
862. }
     
863. 
     
864. 
     
865. sub mainWin {
     
866. 
     
867.   $delta = $sizeOfItems + $distanceBetweenItems;
     
868.   $gameSizex = ($cols + 1) * ($delta);
     
869.   $gameSizey = ($rows +1) * ($delta);
     
870.   $markcolor = $colors + 1;
     
871. 
     
872.   if (Exists($top)) {
     
873. 　　　　$top->withdraw();
     
874.   }
     
875. 
     
876.   my @cascadixRCSVersion = split / /, '$Revision: 1.4 $';
     
877.   my $cascadixVersion = "0.".$cascadixRCSVersion[1];
     
878. 
     
879.   $top = MainWindow->new;
     
880.   $top->title("Cascadix $cascadixVersion");
     
881. 
     
882.   # create the menu
     
883.   my $menu = $top->Frame(-relief => 'raised',
     
884. 　　　　　　　　　　　　　　　　　　　　　　　　 -borderwidth => 2)->pack(-fill => 'x');
     
885. 
     
886.   $menu->Menubutton(-text => "选项",
     
887. 　　　　　　　　　　　　　　　　　　　　-menuitems => [
     
888. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　   [ 'command' => "显示设置",
     
889. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 -command => \&display ],
     
890. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　   [ 'command' => "游戏尺寸",
     
891. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 -command => \&gameSize ],
     
892. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　   [ 'command' => "颜色设置",
     
893. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 -command => \&color ],
     
894. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　  ]
     
895. 　　　　　　　　　　　　　　　　   )->pack(-side => 'left');
     
896. 
     
897.   my $gameF = $top->Frame(-relief => 'raised',
     
898. 　　　　　　　　　　　　　　　　　　　　　　　　  -borderwidth => 2)->pack(-side => 'left',
     
899. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　   -fill => 'x');
     
900.   my $butF = $top->Frame(-relief => 'raised',
     
901. 　　　　　　　　　　　　　　　　　　　　　　　　 -borderwidth => 2)->pack(-side => 'right',
     
902. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　  -fill => 'both');
     
903. 
     
904.   # point
     
905.   $butF->Label(-textvariable => \$points,
     
906. 　　　　　　　　　　　　  )->pack(-side => 'top',
     
907. 　　　　　　　　　　　　　　　　　　　　  -fill => 'both');
     
908. 
     
909.   $canvas = $gameF->Canvas(-width => $gameSizex,
     
910. 　　　　　　　　　　　　　　　　　　　　　　　　   -height => $gameSizey,
     
911. 　　　　　　　　　　　　　　　　　　　　　　　　   -relief => 'sunken',
     
912. 　　　　　　　　　　　　　　　　　　　　　　　　   -bd =>2)->pack(-side=>'top',
     
913. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　  -fill =>'both');;
     
914. 
     
915.   my $newGame =
     
916. 　　　　$butF->Button(-text => "新游戏",
     
917. 　　　　　　　　　　　　　　　　  -command => sub {
     
918. 　　　　　　　　　　　　　　　　　　　　if (Exists($highW)) {
     
919. 　　　　　　　　　　　　　　　　　　　　  $highW->withdraw();
     
920. 　　　　　　　　　　　　　　　　　　　　}
     
921. 　　　　　　　　　　　　　　　　　　　　$canvas->delete('all');
     
922. 　　　　　　　　　　　　　　　　　　　　fillLol();
     
923. 　　　　　　　　　　　　　　　　　　　　$points = 0;
     
924. 　　　　　　　　　　　　　　　　　　　　paintItems();
     
925. 　　　　　　　　　　　　　　　　　　　　$undoB->configure(-state => "disabled");
     
926. 　　　　　　　　　　　　　　　　  }
     
927. 　　　　　　　　　　　　　　　　 )->pack(-side=>'top',
     
928. 　　　　　　　　　　　　　　　　　　　　　　　　 -fill =>'both');
     
929. 
     
930.   $newGame->bind('<Return>',
     
931. 　　　　　　　　　　　　　　　　 sub {
     
932. 　　　　　　　　　　　　　　　　   $newGame->invoke;
     
933. 　　　　　　　　　　　　　　　　 }
     
934. 　　　　　　　　　　　　　　　　);
     
935. 
     
936.   $undoB =
     
937. 　　　　$butF->Button(-text => "撤消",
     
938. 　　　　　　　　　　　　　　　　  -state => "disabled",
     
939. 　　　　　　　　　　　　　　　　  -command => sub {
     
940. 　　　　　　　　　　　　　　　　　　　　copyArray(\@lolcopy, \@lol);
     
941. 　　　　　　　　　　　　　　　　　　　　paintItems();
     
942. 　　　　　　　　　　　　　　　　　　　　$points -= $undopoints;
     
943. 　　　　　　　　　　　　　　　　　　　　$undoB->configure(-state => "disabled");
     
944. 　　　　　　　　　　　　　　　　  }
     
945. 　　　　　　　　　　　　　　　　 )->pack(-side=>'top',
     
946. 　　　　　　　　　　　　　　　　　　　　　　　　 -fill =>'both');
     
947. 
     
948. 
     
949.   $butF->Button(-text => "排行榜",
     
950. 　　　　　　　　　　　　　　　　-command => sub {
     
951. 　　　　　　　　　　　　　　　　  showHigh();
     
952. 　　　　　　　　　　　　　　　　}
     
953. 　　　　　　　　　　　　   )->pack(-side=>'top',
     
954. 　　　　　　　　　　　　　　　　　　　　   -fill =>'both');
     
955. 
     
956.   # quit button
     
957.   $butF->Button(-text => "退出",
     
958. 　　　　　　　　　　　　　　　　-command => sub {
     
959. 　　　　　　　　　　　　　　　　  exit;
     
960. 　　　　　　　　　　　　　　　　}
     
961. 　　　　　　　　　　　　   )->pack(-side=>'top',
     
962. 　　　　　　　　　　　　　　　　　　　　   -fill =>'both');
     
963. 
     
964.   my $cF0 = $butF->Frame(-relief => 'raised',
     
965. 　　　　　　　　　　　　　　　　　　　　　　　　 -borderwidth => 2)->pack(-side => 'top',
     
966. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　  -fill => 'x');
     
967.   $cProgBar0 =
     
968. 　　　　$cF0->ProgressBar(
     
969. 　　　　　　　　　　　　　　　　　　　　  -borderwidth => 1,
     
970. 　　　　　　　　　　　　　　　　　　　　  -relief => 'sunken',
     
971. 　　　　　　　　　　　　　　　　　　　　  -width => 9,
     
972. 　　　　　　　　　　　　　　　　　　　　  -length => 70,
     
973. 　　　　　　　　　　　　　　　　　　　　  -padx => 1,
     
974. 　　　　　　　　　　　　　　　　　　　　  -pady => 1,
     
975. 　　　　　　　　　　　　　　　　　　　　  -variable => \$nrcolor0,
     
976. 　　　　　　　　　　　　　　　　　　　　  -colors => [0 => $color[0]],
     
977. 　　　　　　　　　　　　　　　　　　　　  -troughcolor => 'grey80',
     
978. 　　　　　　　　　　　　　　　　　　　　  -resolution => 1,
     
979. 　　　　　　　　　　　　　　　　　　　　  -blocks => 1,
     
980. 　　　　　　　　　　　　　　　　　　　　  -anchor => 'n',
     
981. 　　　　　　　　　　　　　　　　　　　　  -from => $cmin,
     
982. 　　　　　　　　　　　　　　　　　　　　  -to => $cmax
     
983. 　　　　　　　　　　　　　　　　　　　　 )->pack(-side => 'left',
     
984. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　 -fill => 'x',
     
985. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　 -padx => 3,
     
986. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　 -pady => 0);
     
987. 
     
988.   $cF0->Label(-text => "%")->pack(-side => 'right', -fill => 'both');
     
989.   $cF0->Label(-textvariable => \$nrcolor0,
     
990. 　　　　　　　　　　　　 )->pack(-side => 'right',
     
991. 　　　　　　　　　　　　　　　　　　　　 -fill => 'both');
     
992. 
     
993.   my $cF1 = $butF->Frame(-relief => 'raised',
     
994. 　　　　　　　　　　　　　　　　　　　　　　　　 -borderwidth => 2)->pack(-side => 'top',
     
995. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　  -fill => 'x');
     
996.   $cProgBar1 =
     
997. 　　　　$cF1->ProgressBar(
     
998. 　　　　　　　　　　　　　　　　　　　　  -borderwidth => 1,
     
999. 　　　　　　　　　　　　　　　　　　　　  -relief => 'sunken',
     
1000. 　　　　　　　　　　　　　　　　　　　　  -width => 9,
      
1001. 　　　　　　　　　　　　　　　　　　　　  -length => 70,
      
1002. 　　　　　　　　　　　　　　　　　　　　  -padx => 1,
      
1003. 　　　　　　　　　　　　　　　　　　　　  -pady => 1,
      
1004. 　　　　　　　　　　　　　　　　　　　　  -variable => \$nrcolor1,
      
1005. 　　　　　　　　　　　　　　　　　　　　  -colors => [0 => $color[1]],
      
1006. 　　　　　　　　　　　　　　　　　　　　  -troughcolor => 'grey80',
      
1007. 　　　　　　　　　　　　　　　　　　　　  -resolution => 1,
      
1008. 　　　　　　　　　　　　　　　　　　　　  -blocks => 1,
      
1009. 　　　　　　　　　　　　　　　　　　　　  -anchor => 'n',
      
1010. 　　　　　　　　　　　　　　　　　　　　  -from => $cmin,
      
1011. 　　　　　　　　　　　　　　　　　　　　  -to => $cmax
      
1012. 　　　　　　　　　　　　　　　　　　　　 )->pack(-side => 'left',
      
1013. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　 -fill => 'x',
      
1014. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　 -padx => 3,
      
1015. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　 -pady => 0);
      
1016. 
      
1017.   $cF1->Label(-text => "%")->pack(-side => 'right', -fill => 'both');
      
1018.   $cF1->Label(-textvariable => \$nrcolor1,
      
1019. 　　　　　　　　　　　　 )->pack(-side => 'right',
      
1020. 　　　　　　　　　　　　　　　　　　　　 -fill => 'both');
      
1021. 
      
1022.   my $cF2 = $butF->Frame(-relief => 'raised',
      
1023. 　　　　　　　　　　　　　　　　　　　　　　　　 -borderwidth => 2)->pack(-side => 'top',
      
1024. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　  -fill => 'x');
      
1025.   $cProgBar2 =
      
1026. 　　　　$cF2->ProgressBar(
      
1027. 　　　　　　　　　　　　　　　　　　　　  -borderwidth => 1,
      
1028. 　　　　　　　　　　　　　　　　　　　　  -relief => 'sunken',
      
1029. 　　　　　　　　　　　　　　　　　　　　  -width => 9,
      
1030. 　　　　　　　　　　　　　　　　　　　　  -length => 70,
      
1031. 　　　　　　　　　　　　　　　　　　　　  -padx => 1,
      
1032. 　　　　　　　　　　　　　　　　　　　　  -pady => 1,
      
1033. 　　　　　　　　　　　　　　　　　　　　  -variable => \$nrcolor2,
      
1034. 　　　　　　　　　　　　　　　　　　　　  -colors => [0 => $color[2]],
      
1035. 　　　　　　　　　　　　　　　　　　　　  -troughcolor => 'grey80',
      
1036. 　　　　　　　　　　　　　　　　　　　　  -resolution => 1,
      
1037. 　　　　　　　　　　　　　　　　　　　　  -blocks => 1,
      
1038. 　　　　　　　　　　　　　　　　　　　　  -anchor => 'n',
      
1039. 　　　　　　　　　　　　　　　　　　　　  -from => $cmin,
      
1040. 　　　　　　　　　　　　　　　　　　　　  -to => $cmax
      
1041. 　　　　　　　　　　　　　　　　　　　　 )->pack(-side => 'left',
      
1042. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　 -fill => 'x',
      
1043. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　 -padx => 3,
      
1044. 　　　　　　　　　　　　　　　　　　　　　　　　　　　　 -pady => 0);
      
1045. 
      
1046.   $cF2->Label(-text => "%")->pack(-side => 'right', -fill => 'both');
      
1047.   $cF2->Label(-textvariable => \$nrcolor2,
      
1048. 　　　　　　　　　　　　 )->pack(-side => 'right',
      
1049. 　　　　　　　　　　　　　　　　　　　　 -fill => 'both');
      
1050. 
      
1051. 
      
1052. }
      
1053. 
      
1054. sub color {
      
1055. 
      
1056.   my @colorcopy = @color;
      
1057.   my @colorcancel = @color;
      
1058. 
      
1059.   my @cbut;
      
1060. 
      
1061.   # 打开窗口
      
1062.   my $colorW = $top->Toplevel();
      
1063.   $colorW->title("游戏尺寸");
      
1064. 
      
1065.   if ($colorAvail) {
      
1066. 　　　　$colorW->Label(-text => "颜色",
      
1067. 　　　　　　　　　　　　　　　　  )->pack(-fill => 'x');
      
1068. 
      
1069. 　　　　my $cbutF =
      
1070. 　　　　  $colorW->Frame(-relief => 'raised',
      
1071. 　　　　　　　　　　　　　　　　　　　　 -borderwidth => 2)->pack(-fill => 'x');
      
1072. 
      
1073. 　　　　my $activec;
      
1074. 　　　　my $i = 0;
      
1075. 
      
1076. 　　　　foreach $activec (@colorcopy) {
      
1077. 
      
1078. 　　　　  $cbut[$i] =
      
1079. 　　　　　　　　$cbutF->Button(-text => $activec,
      
1080. 　　　　　　　　　　　　　　　　　　　　   -background => $activec,
      
1081. 　　　　　　　　　　　　　　　　　　　　   -command => sub {
      
1082. 　　　　　　　　　　　　　　　　　　　　　　　　 my $colorD =
      
1083. 　　　　　　　　　　　　　　　　　　　　　　　　   $top->ColourChooser(-colour => $activec);
      
1084. 　　　　　　　　　　　　　　　　　　　　　　　　 my $col = $colorD->Show;
      
1085. 　　　　　　　　　　　　　　　　　　　　　　　　 $activec = $col if ($col);
      
1086. 　　　　　　　　　　　　　　　　　　　　　　　　 for (my $j = 0; $j <= $#colorcopy; $j++) {
      
1087. 　　　　　　　　　　　　　　　　　　　　　　　　   $cbut[$j]->configure(-text => $colorcopy[$j]);
      
1088. 　　　　　　　　　　　　　　　　　　　　　　　　   $cbut[$j]->configure(-background => $colorcopy[$j]);
      
1089. 　　　　　　　　　　　　　　　　　　　　　　　　 }
      
1090. 　　　　　　　　　　　　　　　　　　　　   }
      
1091. 　　　　　　　　　　　　　　　　　　　　  )->pack(-side => 'left');
      
1092. 　　　　  $i++;
      
1093. 　　　　}
      
1094.   } else {
      
1095. 　　　　$colorW->Label(-text => "对不起, 模块Tk::ColourChooser 不可用!",
      
1096. 　　　　　　　　　　　　　　　　  )->pack(-fill => 'x');
      
1097.   }
      
1098. 
      
1099.   $colorW->Label(-text => "预设颜色",
      
1100. 　　　　　　　　　　　　　　　　)->pack(-fill => 'x');
      
1101. 
      
1102.   my $csbutF =
      
1103. 　　　　$colorW->Frame(-relief => 'raised',
      
1104. 　　　　　　　　　　　　　　　　   -borderwidth => 2)->pack(-fill => 'x');
      
1105. 
      
1106.   $csbutF->Button(-text => "预设颜色1",
      
1107. 　　　　　　　　　　　　　　　　  -background => $cpreset1[0],
      
1108. 　　　　　　　　　　　　　　　　  -command => sub {
      
1109. 　　　　　　　　　　　　　　　　　　　　@colorcopy = @cpreset1;
      
1110. 　　　　　　　　　　　　　　　　　　　　my $i = 0;
      
1111. 　　　　　　　　　　　　　　　　　　　　foreach (@cbut) {
      
1112. 　　　　　　　　　　　　　　　　　　　　  $_->configure(-background => $colorcopy[$i]);
      
1113. 　　　　　　　　　　　　　　　　　　　　  $_->configure(-text => $colorcopy[$i]);
      
1114. 　　　　　　　　　　　　　　　　　　　　  $i++;
      
1115. 　　　　　　　　　　　　　　　　　　　　}
      
1116. 　　　　　　　　　　　　　　　　  }
      
1117. 　　　　　　　　　　　　　　　　 )->pack(-side=>'left',
      
1118. 　　　　　　　　　　　　　　　　　　　　　　　　 -expand => 1,
      
1119. 　　　　　　　　　　　　　　　　　　　　　　　　 -fill =>'both');
      
1120. 
      
1121.   $csbutF->Button(-text => "预设颜色2",
      
1122. 　　　　　　　　　　　　　　　　  -background => $cpreset2[0],
      
1123. 　　　　　　　　　　　　　　　　  -command => sub {
      
1124. 　　　　　　　　　　　　　　　　　　　　@colorcopy = @cpreset2;
      
1125. 　　　　　　　　　　　　　　　　　　　　my $i = 0;
      
1126. 　　　　　　　　　　　　　　　　　　　　foreach (@cbut) {
      
1127. 　　　　　　　　　　　　　　　　　　　　  $_->configure(-background => $colorcopy[$i]);
      
1128. 　　　　　　　　　　　　　　　　　　　　  $_->configure(-text => $colorcopy[$i]);
      
1129. 　　　　　　　　　　　　　　　　　　　　  $i++;
      
1130. 　　　　　　　　　　　　　　　　　　　　}
      
1131. 　　　　　　　　　　　　　　　　  }
      
1132. 　　　　　　　　　　　　　　　　 )->pack(-side=>'left',
      
1133. 　　　　　　　　　　　　　　　　　　　　　　　　 -expand => 1,
      
1134. 　　　　　　　　　　　　　　　　　　　　　　　　 -fill =>'both');
      
1135. 
      
1136.   $csbutF->Button(-text => "预设颜色3",
      
1137. 　　　　　　　　　　　　　　　　  -background => $cpreset3[0],
      
1138. 　　　　　　　　　　　　　　　　  -command => sub {
      
1139. 　　　　　　　　　　　　　　　　　　　　@colorcopy = @cpreset3;
      
1140. 　　　　　　　　　　　　　　　　　　　　my $i = 0;
      
1141. 　　　　　　　　　　　　　　　　　　　　foreach (@cbut) {
      
1142. 　　　　　　　　　　　　　　　　　　　　  $_->configure(-background => $colorcopy[$i]);
      
1143. 　　　　　　　　　　　　　　　　　　　　  $_->configure(-text => $colorcopy[$i]);
      
1144. 　　　　　　　　　　　　　　　　　　　　  $i++;
      
1145. 　　　　　　　　　　　　　　　　　　　　}
      
1146. 　　　　　　　　　　　　　　　　  }
      
1147. 　　　　　　　　　　　　　　　　 )->pack(-side=>'left',
      
1148. 　　　　　　　　　　　　　　　　　　　　　　　　 -expand => 1,
      
1149. 　　　　　　　　　　　　　　　　　　　　　　　　 -fill =>'both');
      
1150. 
      
1151.   my $butF =
      
1152. 　　　　$colorW->Frame(-relief => 'raised',
      
1153. 　　　　　　　　　　　　　　　　   -borderwidth => 2)->pack(-fill => 'x');
      
1154. 
      
1155.   $butF->Button(-text => "确定",
      
1156. 　　　　　　　　　　　　　　　　-command => sub {
      
1157. 　　　　　　　　　　　　　　　　  @color = @colorcopy;
      
1158. 　　　　　　　　　　　　　　　　  paintItems();
      
1159. 　　　　　　　　　　　　　　　　  $colorW->withdraw();
      
1160. 　　　　　　　　　　　　　　　　}
      
1161. 　　　　　　　　　　　　   )->pack(-side=>'left',
      
1162. 　　　　　　　　　　　　　　　　　　　　   -expand => 1,
      
1163. 　　　　　　　　　　　　　　　　　　　　   -fill =>'both');
      
1164. 
      
1165.   $butF->Button(-text => "应用",
      
1166. 　　　　　　　　　　　　　　　　-command => sub {
      
1167. 　　　　　　　　　　　　　　　　  @color = @colorcopy;
      
1168. 　　　　　　　　　　　　　　　　  paintItems();
      
1169. 　　　　　　　　　　　　　　　　}
      
1170. 　　　　　　　　　　　　   )->pack(-side=>'left',
      
1171. 　　　　　　　　　　　　　　　　　　　　   -fill =>'both');
      
1172. 
      
1173.   $butF->Button(-text => "取消",
      
1174. 　　　　　　　　　　　　　　　　-command => sub {
      
1175. 　　　　　　　　　　　　　　　　  @color = @colorcancel;
      
1176. 　　　　　　　　　　　　　　　　  paintItems();
      
1177. 　　　　　　　　　　　　　　　　  $colorW->withdraw();
      
1178. 　　　　　　　　　　　　　　　　}
      
1179. 　　　　　　　　　　　　   )->pack(-side=>'right',
      
1180. 　　　　　　　　　　　　　　　　　　　　   -fill =>'both');
      
1181. 
      
1182. }
      
1183. 
      
1184. sub plopItem {
      
1185. 
      
1186. 　　　　my $x = shift;
      
1187. 　　　　my $y = shift;
      
1188. 
      
1189. 　　　　if ($lol[$x][$y] != $markcolor) {
      
1190. 　　　　  warn "plopItem: $x $y is not $markcolor!";
      
1191. 　　　　  return;
      
1192. 　　　　}
      
1193. 
      
1194. 　　　　my $bgc = $canvas->cget(-background);
      
1195. 
      
1196. 　　　　my $item = $canvas->find('closest', ($x*$delta + $offset), ($gameSizey - ($y*$delta)));
      
1197. 　　　　$canvas->delete($item);
      
1198. 
      
1199. 　　　　createDelete($x, $y, ($sizeOfItems+8), ($offset-4), "red");
      
1200. 　　　　createDelete($x, $y, ($sizeOfItems-4), ($offset+2), "blue");
      
1201. 　　　　return;
      
1202. 
      
1203.   }
      
1204. 
      
1205. sub createDelete {
      
1206. 
      
1207.   my $x = shift;
      
1208.   my $y = shift;
      
1209.   my $sizeOfItems = shift;
      
1210.   my $offset = shift;
      
1211.   my $color = shift;
      
1212. 
      
1213.   my $id = $canvas->create($form,
      
1214. 　　　　　　　　　　　　　　　　　　　　　　　　   ($x*$delta + $offset),
      
1215. 　　　　　　　　　　　　　　　　　　　　　　　　   ($gameSizey - ($y*$delta)),
      
1216. 　　　　　　　　　　　　　　　　　　　　　　　　   ($x*$delta + $sizeOfItems + $offset),
      
1217. 　　　　　　　　　　　　　　　　　　　　　　　　   ($gameSizey - ($y*$delta + $sizeOfItems)),
      
1218. 　　　　　　　　　　　　　　　　　　　　　　　　   -fill => $color,
      
1219. 　　　　　　　　　　　　　　　　　　　　　　　　  );
      
1220.   $top->update();
      
1221.   $top->after(3);
      
1222.   $canvas->delete($id);
      
1223.   $top->update();
      
1224.   $top->after(3);
      
1225. 
      
1226. }
      
1227. 
      
1228. 
      
1229. sub copyArray {
      
1230. 
      
1231.   my $arrayARef = shift;
      
1232.   my $arrayBRef = shift;
      
1233.   my $x;
      
1234.   my $y;
      
1235.   for $x (0 .. $cols) {
      
1236. 　　　　for $y (0 .. $rows) {
      
1237. 　　　　  $$arrayBRef[$x][$y] = $$arrayARef[$x][$y];
      
1238. 　　　　}
      
1239.   }
      
1240. }
      
1241. 
      
1242. sub checkName {
      
1243.   my $nameR = shift;
      
1244. 
      
1245.   if (!$$nameR or $$nameR eq "") {
      
1246. 　　　　$$nameR = "A. Nonym";
      
1247.   }
      
1248.   # cut to max length if necessary
      
1249.   if (length($$nameR) > NAMECHARSMAX) {
      
1250. 　　　　$$nameR = substr($$nameR,0,NAMECHARSMAX);
      
1251.   }
      
1252. 
      
1253.   # replace , by ;
      
1254.   $$nameR =~ s/,/;/;
      
1255. }
      
1256. 
      

复制代码

大家可以下下去玩玩，很有意思的。不过需要tk的支持。

sunnybach

我不太懂perl，但也感兴趣，下载，帮忙顶一下
下次要改成C的哦；）

黄叶

为什么要改成C的呢？
呵呵，程序设计没有说一定要用C呀。
在很多方面C开发效率比不上其它的。