|
转自http://www.ilcatperl.org/
- #!/usr/bin/perl -w
- #!/usr/local/bin/perl -w
- use strict;
- use diagnostics;
- use Tk;
- use Tk::Dialog;
- use Tk::After;
- use Tk::ProgressBar;
- #use Tk::Photo;
- my $colorAvail = 0;
- if (eval "require Tk::ColourChooser") {
- $colorAvail = 1;
- }
- # Constants
- # 排行榜最大值
- use constant MAXHIGH => 11;
- # 排行榜里名字的最大长度
- use constant NAMECHARSMAX => 20;
- # 排行榜文件路径和名字
- use constant HIGHSCOREFILE => "C:\\.cascadixHigh";
- # 全局变量
- my $rows = 8; # ! 8 means 0 .. 8 = 9 rows !
- my $cols = 24; # ! 24 means 0 .. 24 = 25 columns!
- my $offset = 4;
- my $colors = 3;
- my $searchMax = 40;
- my @cpreset1 = ( "tomato2", "LightGoldenrod2", "DeepSkyBlue1");
- my @cpreset2 = ( "gray10", "gray50", "gray90");
- my @cpreset3 = ( "blue", "green", "red");
- my @color = @cpreset1;
- my $sizeOfItems = 15;
- my $distanceBetweenItems = 5;
- my $form = 'rectangle'; #'oval';
- my $highscorefile = tilde(HIGHSCOREFILE);
- my $points = 0;
- my $undopoints = 0;
- my $i = 1;
- my $name;
- if ($^O =~ m/Win/) {
- $name = "HansWurst";
- }
- else {
- $name = getpwuid($<);
- }
- my $delta;
- my $gameSizex;
- my $gameSizey;
- my $markcolor;
- # widgets
- my $top;
- my $highW;
- my $canvas;
- my $cProgBar0;
- my $cProgBar1;
- my $cProgBar2;
- my $undoB;
- my $marked;
- my $x;
- my $y;
- my $n;
- my $j;
- # 数组的数组:这是包含条目的二维数组
- my @lol;
- # 为了取消删除@lol的一个拷贝
- my @lolcopy;
- my @colorlist;
- my $nrcolor0;
- my $nrcolor1;
- my $nrcolor2;
- my $cmax;
- my $cmin;
- # 散列的数组
- my @highscore;
- # 主程序
- fillLol();
- mainWin();
- readHigh();
- paintItems();
- $top->MainLoop;
- # 子程序
- my $rep = 0;
- sub fillLol {
- $rep = 0;
- while (1) {
- @lol = ();
- my $color;
- @colorlist = ();
- for (0 .. 2) { $colorlist[$_] = 0; }
- for $x (0 .. $cols) {
- for $y (0 .. $rows) {
- # 选择一个任意颜色
- $color = int(rand 3) + 1;
- # fill the two dimensional array with the color
- $lol[$x][$y] = $color;
- # increase the counter for this color
- $colorlist[$color - 1]++;
- }
- }
- $cmin = 20;
- $cmax = 60;
- # number of blocks
- my $blocks = ($cols + 1)*($rows + 1);
- # round and calculate the percentage of the colors
- $nrcolor0 = sprintf "%.0f", $colorlist[0]/$blocks*100;
- $nrcolor1 = sprintf "%.0f", $colorlist[1]/$blocks*100;
- $nrcolor2 = sprintf "%.0f", $colorlist[2]/$blocks*100;
- # exit loop when a criteria is met
- last if ($nrcolor0 >= $searchMax or
- $nrcolor1 >= $searchMax or
- $nrcolor2 >= $searchMax or
- $rep >= 1000);
- $rep++;
- }
- #print "searched $rep times\n";
- }
- # sub printlol {
- # my $text = shift;
- # my $listRef = shift;
- # print "$rows $cols $text ------------------------\n";
- # for ($x = $rows; $x >= 0; $x--) {
- # for $y ( 0 .. $cols) {
- # if ( $$listRef[$y][$x] ) {
- # if ( $$listRef[$y][$x] == $markcolor) {
- # print "* ";
- # } else {
- # print $$listRef[$y][$x]," ";
- # }
- # } else {
- # print "- ";
- # }
- # }
- # print "\n";
- # }
- # print "------------------------\n";
- # }
- # sub printcolor {
- # print "------------------------\n";
- # for ($x = 0; $x <= 2; $x++) {
- # print "$x $color[$x] $colorlist[$x]\n";
- # }
- # print "------------------------\n";
- # }
- sub markIt {
- my $x = shift;
- my $y = shift;
- my $color = shift;
- # mark this item with the markcolor
- $lol[$x][$y] = $markcolor;
- # count the marked items
- $marked++;
- plopItem($x, $y);
- # look top
- if ($y < $rows) {
- if ($lol[$x][$y+1]) {
- if ($lol[$x][$y+1] == $color) {
- markIt($x, $y+1, $color);
- }
- }
- }
- # look right
- if ($x < $cols) {
- if ($lol[$x+1][$y]) {
- if ($lol[$x+1][$y] == $color) {
- markIt($x+1, $y, $color);
- }
- }
- }
- # look down
- if ($y > 0) {
- if ($lol[$x][$y-1]) {
- if ($lol[$x][$y-1] == $color) {
- markIt($x, $y-1, $color);
- }
- }
- }
- # look left
- if ($x > 0) {
- if ($lol[$x-1][$y]) {
- if ($lol[$x-1][$y] == $color) {
- markIt($x-1, $y, $color);
- }
- }
- }
- }
- sub removeMarked {
- my $i;
- my $j;
- my $aref;
- # from left to right
- for $i ( 0 .. $cols) {
- # and top down
- for ($j = $rows; $j >= 0; $j-- ) {
- if ($lol[$i][$j]) { # if element exists
- if ($lol[$i][$j] == $markcolor) { # and its marked
- splice @{ $lol[$i] }, $j, 1; # cut it out
- }
- }
- }
- }
- # from right to left
- for ($i = $cols; $i >= 0; $i--) {
- my @array = @{ $lol[$i] }; # @array is a colunm of @lol
- my $sum = 0;
- foreach (@array) {
- $sum += $_ if (defined($_));
- } # buid the sum of all elements in col $i
- if ($sum <= 0) { # if this col is empty
- splice @lol, $i, 1; # cut it out of @lol
- }
- }
- }
- sub paintItems {
- my ($x, $y, $col, $id);
- removeMarked();
- $canvas->delete('all');
- for $x (0 .. $cols) {
- for $y (0 .. $rows) {
- if ($lol[$x][$y]) {
- if ($lol[$x][$y] > 0) {
- my $col = $color[$lol[$x][$y]-1];
- #my $tag = "item-$x-$y";
- my $id = $canvas->create($form,
- ($x*$delta + $offset),
- ($gameSizey - ($y*$delta)),
- ($x*$delta + $sizeOfItems + $offset),
- ($gameSizey - ($y*$delta + $sizeOfItems)),
- -fill => $col,
- );
- $canvas->bind($id,'<Button-1>',
- sub {
- my $i;
- my @coor = $canvas->coords($id);
- my $indexx = int($coor[0]/$delta);
- my $indexy = $rows - int($coor[1]/$delta);
- $marked = 0;
- # remember the color
- my $color = $lol[$indexx][$indexy];
- # remember the array for undo action
- copyArray(\@lol, \@lolcopy);
- $undoB->configure(-state => "normal");
- markIt($indexx, $indexy, $color);
- # if just found one, give him the color back and redraw all items
- if ($marked <= 1) {
- $lol[$indexx][$indexy] = $color;
- paintItems();
- return;
- }
- my $newPoints = 0;
- for ($i = 1; $i <= $marked; $i++) {
- $newPoints = $newPoints + $i;
- }
- $points = $points + $newPoints;
- # remember the additional point for a undo move
- $undopoints = $newPoints;
- #removeMarked();
- paintItems();
- if (reachedEnd()) {
- eog();
- }
- });
- }
- }
- }
- }
- }
- sub reachedEnd {
- my ($x, $y, $found);
- if (!$lol[0][0]) {
- # cleaned everything up!
- my $dialog =
- $top->Dialog(-title => "Bonus",
- -text => "太棒了!\n你清理干净了所有的目标!\n 奖励 500 点!",
- -buttons => ["OK"]);
- $dialog->Show();
- $points = $points + 500;
- return 1;
- }
- $found = 0;
- for $x (0 .. $cols) {
- for $y (0 .. $rows) {
- if ($lol[$x][$y]) {
- if ($lol[$x][$y] > 0 && $lol[$x][$y] < $markcolor) {
- if (countIt($x, $y, $lol[$x][$y])) {
- $found++;
- last;
- }
- }
- } else {
- # we are searching bottom-up,
- # if there is nothing here there can`t be anything
- # in the higher positions
- #print "... is empty\n";
- last;
- }
- last if ($found > 0);
- }
- last if ($found > 0);
- }
- if ($found == 0) {
- return 1;
- } else {
- return 0;
- }
- }
- sub countIt {
- my $x = shift;
- my $y = shift;
- my $color = shift;
- # look top
- if ($y < $rows) {
- if ($lol[$x][$y+1]) {
- if ($lol[$x][$y+1] == $color) {
- return 1;
- }
- }
- }
- # look right
- if ($x < $cols) {
- if ($lol[$x+1][$y]) {
- if ($lol[$x+1][$y] == $color) {
- return 1;
- }
- }
- }
- # look down
- if ($y > 0) {
- if ($lol[$x][$y-1]) {
- if ($lol[$x][$y-1] == $color) {
- return 1;
- }
- }
- }
- # look left
- if ($x > 0) {
- if ($lol[$x-1][$y]) {
- if ($lol[$x-1][$y] == $color) {
- return 1;
- }
- }
- }
- return 0;
- }
- sub resetHigh {
- my $i;
- # reset highscore
- @highscore = ();
- # fill with default values
- for ($i = 0; $i < MAXHIGH; $i++) {
- my$rec = {};
- my $name = "John Doe";
- my $points = 0;
- $rec->{"name"} = $name;
- $rec->{"points"} = $points;
- push @highscore, $rec;
- }
- showHigh();
- }
- # sub printHigh {
- # my $i;
- # foreach (@highscore) {
- # $i++;
- # if ($_->{'name'}) {
- # print "$i ".$_->{'name'}." ".$_->{'points'}."\n";
- # }
- # }
- # }
- sub showHigh {
- my $select = shift;
- $select = $select + 3 if $select;
- my $i;
- if (Exists($highW)) {
- $highW->withdraw();
- }
- # open window
- $highW = $top->Toplevel();
- $highW->title("Cascadix 排行榜");
- my $highlist =
- $highW->Scrolled("Listbox",
- -scrollbars => 'osoe',
- -selectmode => 'single',
- -width => 36,
- -height => 15)->pack(-expand => 1,
- -fill =>'both',
- -padx => 3,
- -pady => 3);
- my $OKB =
- $highW->Button(-text => "确定",
- -command => sub {
- $highW->withdraw();
- return;
- })->pack(-side => 'top',
- -fill => 'x',
- -padx => 3,
- -pady => 3);
- $OKB->bind('<Return>',
- sub {
- $OKB->invoke;
- }
- );
- $highlist->insert('end', "");
- $highlist->insert('end', "排名 名字 点数");
- $highlist->insert('end', "");
- foreach (@highscore) {
- $i++;
- if ($_->{'name'}) {
- # the * is the placeholder for NAMECHARSMAX
- my $line = sprintf " %3d. %-*s %6d", $i, NAMECHARSMAX, $_->{'name'}, $_->{'points'};
- $highlist->insert('end', $line);
- }
- }
- if ($select) {
- $highlist->selectionSet($select);
- $highlist->see(0);
- $highlist->see($select);
- }
- $highW->waitWindow;
- }
- sub eog {
- # cut list to maxHigh
- splice @highscore, (MAXHIGH - 1);
- my $i = 0;
- my $inHigh = 0;
- foreach (@highscore) {
- if ($points > $_->{'points'}) {
- $inHigh = 1;
- last;
- }
- $i++;
- }
- if ($inHigh or ($i < MAXHIGH)) {
- insertPlayer($i);
- } else {
- my $dialog =
- $top->Dialog(-title => "EOG: 游戏结束",
- -text => "游戏结束\n$points 点.\n 这个成绩太差劲了.",
- -buttons => ["再来一次!"]);
- $dialog->Show();
- }
- saveHigh();
- showHigh($i-1);
- }
- sub insertPlayer {
- my $i =shift;
- my $rc = getName($i+1);
- if ($rc eq "OK") {
- checkName(\$name);
- # cut off the second part and store it in highscoreTmp
- my @highscoreTmp = splice @highscore, $i;
- # insert a new DS
- my $rec = {}; # record zuruecksetzten
- $rec->{'name'} = $name;
- $rec->{'points'} = $points;
- push @highscore, $rec;
- # add the highscoreTmp to highscore
- push @highscore, @highscoreTmp;
- }
- }
- sub readHigh {
- my ($field, $key, $value);
- if (! -f $highscorefile) {
- warn "readHigh: $highscorefile not found";
- resetHigh();
- #saveHigh();
- return;
- }
- if (!open(DATEI, "<$highscorefile")) {
- warn "readHigh: Can't open $highscorefile: $!\n";
- resetHigh();
- return;
- }
- # reset highscore list
- @highscore = ();
- LINE: while (<DATEI>) {
- next LINE if /^$/; # Leerzeilen ueberspringen
- next LINE if /^#/; # Kommentarzeilen ueberspringen
- my $rec; # record zuruecksetzten
- chomp; # removes the newlines from $_
- FIELD: for $field ( split /,/) {
- ($key, $value) = split /=/, $field; # key und value trennen (=-Zeichen)
- if ($rec->{$key}) {
- warn "$highscorefile Zeile: $.: Der key ($key) ist mehrfach vorhanden!";
- }
- $rec->{$key} = $value;
- }
- push @highscore, $rec;
- }
- close(DATEI);
- }
- sub saveHigh {
- if (!open(SAVEFILE, ">$highscorefile")) {
- warn "Can't open $highscorefile for write: $!\n";
- return 0;
- }
- #my $i;
- foreach ( @highscore ) {
- for my $key ( sort keys %{ $_ } ) {
- print SAVEFILE "$key=$_->{$key},";
- }
- # Zeilenumbruch am Ende eines Datensatzes
- print SAVEFILE "\n";
- }
- if (!close(SAVEFILE)) {
- warn "error closing $highscorefile: $!\n";
- return 0;
- }
- return 1;
- }
- sub getName {
- my $p = shift;
- my $rc;
- # open window
- my $myDiag = $top->Toplevel();
- $myDiag->title("Game over");
- $myDiag->Label(-text => "你获得了 $points 点.\n恭喜你!\n你在排行榜里排名第 $p !\n请输入你的名字:",
- )->pack(-side => 'top',
- -fill => 'x',
- -padx => 3,
- -pady => 3);
- my $entry =
- $myDiag->Entry(-textvariable => \$name,
- -width => 80,
- )->pack(-side => 'top',
- -fill => 'x',
- -padx => 3,
- -pady => 3);
- my $ButF =
- $myDiag->Frame()->pack(-fill =>'x',
- -padx => 3,
- -pady => 3);
- my $OKB =
- $ButF->Button(-text => "确定",
- -command => sub {
- $rc = "OK";
- $myDiag->destroy();
- return "OK";
- })->pack(-side => 'left',
- -expand => 1,
- -fill => 'x',
- -padx => 3,
- -pady => 3);
- $entry->bind('<Return>',
- sub {
- $OKB->invoke;
- }
- );
- $ButF->Button(-text => "取消",
- -command => sub {
- $rc = "Cancel";
- $myDiag->destroy();
- return "Cancel";
- }
- )->pack(-side => 'left',
- -expand => 1,
- -fill => 'x',
- -padx => 3,
- -pady => 3);
- $myDiag->waitWindow;
- return $rc;
- }
- ##############################################################
- #
- # tilde
- #
- ##############################################################
- sub tilde {
- my $name = shift;
- return $name if ($^O =~ m/Win/);
- $name =~ s{ ^ ~ ( [^/]* ) }
- { $1
- ? (getpwnam($1))[7]
- : ( $ENV{HOME} || $ENV{LOGDIR}
- || (getpwuid($<))[7]
- )
- }ex;
- return $name;
- }
- sub display {
- my $distcopy = $distanceBetweenItems;
- my $distcancel = $distanceBetweenItems;
- my $sizecopy = $sizeOfItems;
- my $sizecancel = $sizeOfItems;
- my $formcopy = $form;
- my $formcancel = $form;
- # open window
- my $displayW = $top->Toplevel();
- $displayW->title("显示选项");
- $displayW->Label(-text => "目标尺寸",
- )->pack(-fill => 'x');
- $displayW->Scale(-variable => \$sizecopy,
- -orient => 'horizontal',
- -from => 5,
- -to => 40,
- -relief => 'raised'
- )->pack(-fill =>'x',
- -expand => 1);
- $displayW->Label(-text => "目标间距",
- )->pack(-fill => 'x');
- $displayW->Scale(-variable => \$distcopy,
- -orient => 'horizontal',
- -from => 1,
- -to => 10,
- -relief => 'raised'
- )->pack(-fill =>'x',
- -expand => 1);
- $displayW->Label(-text => "目标形状",
- )->pack(-fill => 'x');
- $displayW->Radiobutton(-text => "圆形",
- -variable => \$formcopy,
- -value => "oval")->pack(-fill =>'x');
- $displayW->Radiobutton(-text => "矩形",
- -variable => \$formcopy,
- -value => "rectangle")->pack(-fill =>'x');
- my $butF =
- $displayW->Frame(-relief => 'raised',
- -borderwidth => 2)->pack(-side => 'left',
- -fill => 'x');
- $butF->Button(-text => "确定",
- -command => sub {
- $distanceBetweenItems = $distcopy;
- $form = $formcopy;
- $sizeOfItems = $sizecopy;
- mainWin();
- paintItems();
- $displayW->withdraw();
- }
- )->pack(-side=>'left',
- -fill =>'both');
- $butF->Button(-text => "应用",
- -command => sub {
- $distanceBetweenItems = $distcopy;
- $sizeOfItems = $sizecopy;
- $form = $formcopy;
- mainWin();
- paintItems();
- }
- )->pack(-side=>'left',
- -fill =>'both');
- $butF->Button(-text => "取消",
- -command => sub {
- $distanceBetweenItems = $distcancel;
- $sizeOfItems = $sizecancel;
- $form = $formcancel;
- mainWin();
- paintItems();
- $displayW->withdraw();
- }
- )->pack(-side=>'right',
- -fill =>'both');
- }
- sub gameSize {
- my $rowscopy = $rows + 1;
- my $colscopy = $cols + 1;
- my $rowscancel = $rows;
- my $colscancel = $cols;
- # open window
- my $gameSizeW = $top->Toplevel();
- $gameSizeW->title("游戏尺寸");
- $gameSizeW->Label(-text => "行数:",
- )->pack(-fill => 'x');
- $gameSizeW->Scale(-variable => \$rowscopy,
- -orient => 'horizontal',
- -from => 3,
- -to => 9,
- -relief => 'raised'
- )->pack(-fill =>'x',
- -expand => 1);
- $gameSizeW->Label(-text => "列数:",
- )->pack(-fill => 'x');
- $gameSizeW->Scale(-variable => \$colscopy,
- -orient => 'horizontal',
- -from => 3,
- -to => 25,
- -relief => 'raised'
- )->pack(-fill =>'x',
- -expand => 1);
- my $butF =
- $gameSizeW->Frame(-relief => 'raised',
- -borderwidth => 2)->pack(-side => 'left',
- -fill => 'x');
- $butF->Button(-text => "确定",
- -command => sub {
- if ($rows != ($rowscopy - 1) or $cols != ($colscopy - 1)) {
- $rows = $rowscopy - 1;
- $cols = $colscopy - 1;
- fillLol();
- $points = 0;
- mainWin();
- paintItems();
- }
- $gameSizeW->withdraw();
- }
- )->pack(-side=>'left',
- -fill =>'both');
- $butF->Button(-text => "应用",
- -command => sub {
- if ($rows != ($rowscopy - 1) or $cols != ($colscopy - 1)) {
- $rows = $rowscopy - 1;
- $cols = $colscopy - 1;
- fillLol();
- $points = 0;
- mainWin();
- paintItems();
- }
- }
- )->pack(-side=>'left',
- -fill =>'both');
- $butF->Button(-text => "取消",
- -command => sub {
- if ($rows != $rowscancel or $cols != $colscancel) {
- $rows = $rowscancel;
- $cols = $colscancel;
- fillLol();
- $points = 0;
- mainWin();
- paintItems();
- }
- $gameSizeW->withdraw();
- }
- )->pack(-side=>'right',
- -fill =>'both');
- }
- sub mainWin {
- $delta = $sizeOfItems + $distanceBetweenItems;
- $gameSizex = ($cols + 1) * ($delta);
- $gameSizey = ($rows +1) * ($delta);
- $markcolor = $colors + 1;
- if (Exists($top)) {
- $top->withdraw();
- }
- my @cascadixRCSVersion = split / /, '$Revision: 1.4 $';
- my $cascadixVersion = "0.".$cascadixRCSVersion[1];
- $top = MainWindow->new;
- $top->title("Cascadix $cascadixVersion");
- # create the menu
- my $menu = $top->Frame(-relief => 'raised',
- -borderwidth => 2)->pack(-fill => 'x');
- $menu->Menubutton(-text => "选项",
- -menuitems => [
- [ 'command' => "显示设置",
- -command => \&display ],
- [ 'command' => "游戏尺寸",
- -command => \&gameSize ],
- [ 'command' => "颜色设置",
- -command => \&color ],
- ]
- )->pack(-side => 'left');
- my $gameF = $top->Frame(-relief => 'raised',
- -borderwidth => 2)->pack(-side => 'left',
- -fill => 'x');
- my $butF = $top->Frame(-relief => 'raised',
- -borderwidth => 2)->pack(-side => 'right',
- -fill => 'both');
- # point
- $butF->Label(-textvariable => \$points,
- )->pack(-side => 'top',
- -fill => 'both');
- $canvas = $gameF->Canvas(-width => $gameSizex,
- -height => $gameSizey,
- -relief => 'sunken',
- -bd =>2)->pack(-side=>'top',
- -fill =>'both');;
- my $newGame =
- $butF->Button(-text => "新游戏",
- -command => sub {
- if (Exists($highW)) {
- $highW->withdraw();
- }
- $canvas->delete('all');
- fillLol();
- $points = 0;
- paintItems();
- $undoB->configure(-state => "disabled");
- }
- )->pack(-side=>'top',
- -fill =>'both');
- $newGame->bind('<Return>',
- sub {
- $newGame->invoke;
- }
- );
- $undoB =
- $butF->Button(-text => "撤消",
- -state => "disabled",
- -command => sub {
- copyArray(\@lolcopy, \@lol);
- paintItems();
- $points -= $undopoints;
- $undoB->configure(-state => "disabled");
- }
- )->pack(-side=>'top',
- -fill =>'both');
- $butF->Button(-text => "排行榜",
- -command => sub {
- showHigh();
- }
- )->pack(-side=>'top',
- -fill =>'both');
- # quit button
- $butF->Button(-text => "退出",
- -command => sub {
- exit;
- }
- )->pack(-side=>'top',
- -fill =>'both');
- my $cF0 = $butF->Frame(-relief => 'raised',
- -borderwidth => 2)->pack(-side => 'top',
- -fill => 'x');
- $cProgBar0 =
- $cF0->ProgressBar(
- -borderwidth => 1,
- -relief => 'sunken',
- -width => 9,
- -length => 70,
- -padx => 1,
- -pady => 1,
- -variable => \$nrcolor0,
- -colors => [0 => $color[0]],
- -troughcolor => 'grey80',
- -resolution => 1,
- -blocks => 1,
- -anchor => 'n',
- -from => $cmin,
- -to => $cmax
- )->pack(-side => 'left',
- -fill => 'x',
- -padx => 3,
- -pady => 0);
- $cF0->Label(-text => "%")->pack(-side => 'right', -fill => 'both');
- $cF0->Label(-textvariable => \$nrcolor0,
- )->pack(-side => 'right',
- -fill => 'both');
- my $cF1 = $butF->Frame(-relief => 'raised',
- -borderwidth => 2)->pack(-side => 'top',
- -fill => 'x');
- $cProgBar1 =
- $cF1->ProgressBar(
- -borderwidth => 1,
- -relief => 'sunken',
- -width => 9,
- -length => 70,
- -padx => 1,
- -pady => 1,
- -variable => \$nrcolor1,
- -colors => [0 => $color[1]],
- -troughcolor => 'grey80',
- -resolution => 1,
- -blocks => 1,
- -anchor => 'n',
- -from => $cmin,
- -to => $cmax
- )->pack(-side => 'left',
- -fill => 'x',
- -padx => 3,
- -pady => 0);
- $cF1->Label(-text => "%")->pack(-side => 'right', -fill => 'both');
- $cF1->Label(-textvariable => \$nrcolor1,
- )->pack(-side => 'right',
- -fill => 'both');
- my $cF2 = $butF->Frame(-relief => 'raised',
- -borderwidth => 2)->pack(-side => 'top',
- -fill => 'x');
- $cProgBar2 =
- $cF2->ProgressBar(
- -borderwidth => 1,
- -relief => 'sunken',
- -width => 9,
- -length => 70,
- -padx => 1,
- -pady => 1,
- -variable => \$nrcolor2,
- -colors => [0 => $color[2]],
- -troughcolor => 'grey80',
- -resolution => 1,
- -blocks => 1,
- -anchor => 'n',
- -from => $cmin,
- -to => $cmax
- )->pack(-side => 'left',
- -fill => 'x',
- -padx => 3,
- -pady => 0);
- $cF2->Label(-text => "%")->pack(-side => 'right', -fill => 'both');
- $cF2->Label(-textvariable => \$nrcolor2,
- )->pack(-side => 'right',
- -fill => 'both');
- }
- sub color {
- my @colorcopy = @color;
- my @colorcancel = @color;
- my @cbut;
- # 打开窗口
- my $colorW = $top->Toplevel();
- $colorW->title("游戏尺寸");
- if ($colorAvail) {
- $colorW->Label(-text => "颜色",
- )->pack(-fill => 'x');
- my $cbutF =
- $colorW->Frame(-relief => 'raised',
- -borderwidth => 2)->pack(-fill => 'x');
- my $activec;
- my $i = 0;
- foreach $activec (@colorcopy) {
- $cbut[$i] =
- $cbutF->Button(-text => $activec,
- -background => $activec,
- -command => sub {
- my $colorD =
- $top->ColourChooser(-colour => $activec);
- my $col = $colorD->Show;
- $activec = $col if ($col);
- for (my $j = 0; $j <= $#colorcopy; $j++) {
- $cbut[$j]->configure(-text => $colorcopy[$j]);
- $cbut[$j]->configure(-background => $colorcopy[$j]);
- }
- }
- )->pack(-side => 'left');
- $i++;
- }
- } else {
- $colorW->Label(-text => "对不起, 模块Tk::ColourChooser 不可用!",
- )->pack(-fill => 'x');
- }
- $colorW->Label(-text => "预设颜色",
- )->pack(-fill => 'x');
- my $csbutF =
- $colorW->Frame(-relief => 'raised',
- -borderwidth => 2)->pack(-fill => 'x');
- $csbutF->Button(-text => "预设颜色1",
- -background => $cpreset1[0],
- -command => sub {
- @colorcopy = @cpreset1;
- my $i = 0;
- foreach (@cbut) {
- $_->configure(-background => $colorcopy[$i]);
- $_->configure(-text => $colorcopy[$i]);
- $i++;
- }
- }
- )->pack(-side=>'left',
- -expand => 1,
- -fill =>'both');
- $csbutF->Button(-text => "预设颜色2",
- -background => $cpreset2[0],
- -command => sub {
- @colorcopy = @cpreset2;
- my $i = 0;
- foreach (@cbut) {
- $_->configure(-background => $colorcopy[$i]);
- $_->configure(-text => $colorcopy[$i]);
- $i++;
- }
- }
- )->pack(-side=>'left',
- -expand => 1,
- -fill =>'both');
- $csbutF->Button(-text => "预设颜色3",
- -background => $cpreset3[0],
- -command => sub {
- @colorcopy = @cpreset3;
- my $i = 0;
- foreach (@cbut) {
- $_->configure(-background => $colorcopy[$i]);
- $_->configure(-text => $colorcopy[$i]);
- $i++;
- }
- }
- )->pack(-side=>'left',
- -expand => 1,
- -fill =>'both');
- my $butF =
- $colorW->Frame(-relief => 'raised',
- -borderwidth => 2)->pack(-fill => 'x');
- $butF->Button(-text => "确定",
- -command => sub {
- @color = @colorcopy;
- paintItems();
- $colorW->withdraw();
- }
- )->pack(-side=>'left',
- -expand => 1,
- -fill =>'both');
- $butF->Button(-text => "应用",
- -command => sub {
- @color = @colorcopy;
- paintItems();
- }
- )->pack(-side=>'left',
- -fill =>'both');
- $butF->Button(-text => "取消",
- -command => sub {
- @color = @colorcancel;
- paintItems();
- $colorW->withdraw();
- }
- )->pack(-side=>'right',
- -fill =>'both');
- }
- sub plopItem {
- my $x = shift;
- my $y = shift;
- if ($lol[$x][$y] != $markcolor) {
- warn "plopItem: $x $y is not $markcolor!";
- return;
- }
- my $bgc = $canvas->cget(-background);
- my $item = $canvas->find('closest', ($x*$delta + $offset), ($gameSizey - ($y*$delta)));
- $canvas->delete($item);
- createDelete($x, $y, ($sizeOfItems+8), ($offset-4), "red");
- createDelete($x, $y, ($sizeOfItems-4), ($offset+2), "blue");
- return;
- }
- sub createDelete {
- my $x = shift;
- my $y = shift;
- my $sizeOfItems = shift;
- my $offset = shift;
- my $color = shift;
- my $id = $canvas->create($form,
- ($x*$delta + $offset),
- ($gameSizey - ($y*$delta)),
- ($x*$delta + $sizeOfItems + $offset),
- ($gameSizey - ($y*$delta + $sizeOfItems)),
- -fill => $color,
- );
- $top->update();
- $top->after(3);
- $canvas->delete($id);
- $top->update();
- $top->after(3);
- }
- sub copyArray {
- my $arrayARef = shift;
- my $arrayBRef = shift;
- my $x;
- my $y;
- for $x (0 .. $cols) {
- for $y (0 .. $rows) {
- $$arrayBRef[$x][$y] = $$arrayARef[$x][$y];
- }
- }
- }
- sub checkName {
- my $nameR = shift;
- if (!$$nameR or $$nameR eq "") {
- $$nameR = "A. Nonym";
- }
- # cut to max length if necessary
- if (length($$nameR) > NAMECHARSMAX) {
- $$nameR = substr($$nameR,0,NAMECHARSMAX);
- }
- # replace , by ;
- $$nameR =~ s/,/;/;
- }
复制代码
大家可以下下去玩玩,很有意思的。不过需要tk的支持。 |
|