#!perl
##################
#
# Based on file automatically generated by ZooZ.pl v1.2
# on Wed Mar 11 10:06:20 2009.
#
# author: Maciej Misiak (grizzley@poczta.onet.pl
#
# version 1.1
#
##################
use strict;
use warnings;
use Tk 804;
if(@ARGV)
{
generate(@ARGV);
exit;
}
my @costs = map [split], <DATA>;
my $NUM_OF_NODES = @costs;
my $GROUP_SIZE = $NUM_OF_NODES/2;
my @group1ids = (0..$GROUP_SIZE-1);
my @group2ids = ($GROUP_SIZE..$NUM_OF_NODES-1);
my @connections = sort {$a <=> $b }
map
{ my $r=$_; map { $costs[$r][$_] } $_+1..$NUM_OF_NODES-1 }
0..$NUM_OF_NODES-1;
my $numbetweengroups = $GROUP_SIZE * $GROUP_SIZE;
my $numinsidegroups = @connections - $numbetweengroups;
# print "[@connections]\n";
my $ideal_score = 0;
my %ideal_connections;
# green -> yellow -> red
my @mincolors = ('chartreuse4', 'coral2');
my @midcolors = ('chartreuse4', 'yellow', 'orange', 'coral2');
my @maxcolors = ('chartreuse4', 'chartreuse3', 'chartreuse', 'yellow',
+ 'orange','coral1', 'coral3', 'coral4');
my $colref;
if($NUM_OF_NODES < 7)
{ $colref = \@mincolors }
elsif($NUM_OF_NODES < 13)
{ $colref = \@midcolors }
else
{ $colref = \@maxcolors }
# in this loop save colors for all connection values in hash
# if you want more/less colors - manipulate array above
for(0..$#connections)
{
if($_<$numbetweengroups)
{ $ideal_score += $connections[$_] }
# this factor has some value in range [0, 1]
my $factor = ($connections[$_]-$connections[0]) / ($connections[-1
+]-$connections[0]);
# if equal 1.0, index (@colors * $factor) would be equal to @color
+s and out of range...
if($factor == 1.0)
{ $ideal_connections{$connections[$_]} = $$colref[-1] }
else
{ $ideal_connections{$connections[$_]} = $$colref[@$colref * $
+factor] }
}
my $optimal_score = '???';
my $current_score = 0;
# generate list of numbers, those will be displayed on buttons
my @nodes = (0..$NUM_OF_NODES-1);
# when placing nodes on the grid, we want to have circle:
# 0
# 5 1
# x x
# x x
#
# x x
# x x
# 4 2
# 3
# x's are our nodes, digits are nodes, which will be in coords table
# but we want ommit it when displaying
my $num_extra_nodes = 6;
my $off1 = 1;
my $off2 = 2;
# coordinates of buttons:
my $max_coord = $NUM_OF_NODES + $num_extra_nodes;
my $unit = 6.28 / $max_coord;
# sin & cos returns range [-1.0 , 1.0]
# and should be mapped to something in range [0.0, 1.0]
# that will make use in -relx, -rely params possible
my @coords = map
{ [ corrx(sin $unit*$_), corry(- cos $unit*$_) ] }
$off1 .. $max_coord/2-1-$off2 , $max_coord/2+1+$off2 .. $max_c
+oord-$off1;
# two correction functions for x and y coordinates of buttons
# coordinates are here in range [-1.0 , 1.0]
# translate x range to [0.1, 0.9]
sub corrx { ($_[0] * 0.8 + 1.0) / 2 }
# translate y range to [0, 0.8]
sub corry { ($_[0] + 1.0) * 0.8 / 2 }
# print "[@$_] " for @coords;
# which button is selected in both groups
my $group1selected = 0;
my $group2selected = $NUM_OF_NODES/2;
my $MW = MainWindow->new(-width => 500, -height => 500);
my %ZWIDGETS;
# canvas to draw connections
my $c = $MW->Canvas(-borderwidth => 0)
-> place('-x' => 0, '-y' => 0, '-relwidth' => 1.0, '-relheight' =>
+ 1.0);
# ideal score label
my $is = $MW->Label(-text => 'Ideal score: '.$ideal_score)
-> place(-relx => 0, '-rely' => 0.8);
# optimal score label
my $os = $MW->Label(-text => 'Ideal possible to achieve score: '.$opti
+mal_score)
-> place(-relx => .3, '-rely' => 0.8);
# current score label
my $cs = $MW->Label(-text => 'Current score: '.$current_score)
-> place(-relx => 0.5, '-rely' => 0.72, -anchor => 'center');
$MW->Button(-command => 'main::swapNodes', -text => 'Swap')
->place(-relx => 0.5, '-rely' => 0.77, -anchor => 'center');
$MW->Label(-wraplength => 300, -text => 'The goal of this game is to '
.'place all green connections between left and right group of node
+s,'
.' and red connections inside groups. Sum of all connections betwe
+en left'
.' and right nodes is a score. Click one node from each '
.'group and click \'swap\' button to swap nodes.')
->place(-relx => 0.5, '-rely' => 0.92, -anchor => 'center');
#################################################
# first group
#################################################
my $selected=0;
for(@group1ids)
{
$ZWIDGETS{'Button'.$_} = $MW->Button(
-command => ['main::selectButton', $_],
-relief => $selected++ ? 'raised' : 'sunken',
-textvariable => \$nodes[$_],
)->place(
'-relx' => $coords[$_][0],
'-rely' => $coords[$_][1],
-anchor => "center"
)
}
#################################################
# second group
#################################################
$selected=0;
for(@group2ids)
{
$ZWIDGETS{'Button'.$_} = $MW->Button(
-command => ['main::selectButton', $_],
-relief => $selected++ ? 'raised' : 'sunken',
-textvariable => \$nodes[$_],
)->place(
'-relx' => $coords[$_][0],
'-rely' => $coords[$_][1],
-anchor => "center"
)
}
###############
#
# MainLoop
#
###############
$MW->bind('<Configure>' => sub { drawConnections() });
updateScore();
MainLoop;
sub selectButton
{
my $buttonNum = shift;
if($buttonNum >=0 && $buttonNum < $GROUP_SIZE)
{
for(@group1ids)
{ $ZWIDGETS{'Button'.$_}->configure(-relief => 'raised') }
$ZWIDGETS{'Button'.$buttonNum}->configure(-relief => 'sunken')
+;
$group1selected = $buttonNum;
}
elsif($buttonNum >=$GROUP_SIZE && $buttonNum < $NUM_OF_NODES)
{
for(@group2ids)
{ $ZWIDGETS{'Button'.$_}->configure(-relief => 'raised') }
$ZWIDGETS{'Button'.$buttonNum}->configure(-relief => 'sunken')
+;
$group2selected = $buttonNum;
}
}
sub swapNodes
{
if($group1selected<0 || $group1selected>$NUM_OF_NODES-1)
{ warn "wrong index of node1 selection ($group1selected), abor
+ting operation\n" }
if($group2selected<0 || $group2selected>$NUM_OF_NODES-1)
{ warn "wrong index of node2 selection ($group2selected), abor
+ting operation\n" }
($nodes[$group1selected], $nodes[$group2selected]) =
($nodes[$group2selected], $nodes[$group1selected]);
updateScore();
drawConnections()
}
sub drawConnections
{
$c->delete('all');
for my $srcNode(0..$NUM_OF_NODES-1)
{
for my $dstNode($srcNode+1..$NUM_OF_NODES-1)
{
my $x0 = $ZWIDGETS{'Button'.$srcNode}->x + $ZWIDGETS{'Butt
+on'.$srcNode}->width / 2;
my $y0 = $ZWIDGETS{'Button'.$srcNode}->y + $ZWIDGETS{'Butt
+on'.$srcNode}->height / 2;
my $node0 = $ZWIDGETS{'Button'.$srcNode}->cget('-text');
my $x1 = $ZWIDGETS{'Button'.$dstNode}->x + $ZWIDGETS{'Butt
+on'.$srcNode}->width / 2;
my $y1 = $ZWIDGETS{'Button'.$dstNode}->y + $ZWIDGETS{'Butt
+on'.$srcNode}->height / 2;
my $node1 = $ZWIDGETS{'Button'.$dstNode}->cget('-text');
my $color = $ideal_connections{$costs[$node0][$node1]};
$c->createLine($x0, $y0, $x1, $y1, -fill => $color);
$c->createText(($x0+$x1)/2, ($y0+$y1)/2, -text => $costs[$
+node0][$node1], -fill => $color);
}
}
}
sub updateScore
{
$current_score = 0;
for my $src(@nodes[@group1ids])
{
for my $dst(@nodes[@group2ids])
{
$current_score += $costs[$src][$dst]
}
}
$cs->configure(-text => 'Current score: ' . $current_score);
}
sub generate
{
my $cnt = shift;
if ($cnt<0 || $cnt%2) { die 'Enter even positive integer! '.$cnt.'
+ is not valid.' }
my $limit = $cnt-1;
my @f;
my %uniq;
for my$x(0..$limit)
{
for my$y($x+1..$limit)
{
my $res = int rand(3*$cnt*$cnt);
while(defined $uniq{$res})
{ $res = int rand(3*$cnt*$cnt) }
$f[$x][$y]=$f[$y][$x]=$res;
$uniq{$res}++;
}
}
for(0..$limit)
{ $f[$_][$_]='-' }
for(@f)
{ print join(' ', @$_), "\n" }
}
__DATA__
- 159 38 172 76 143 155 78 282 58
159 - 7 264 128 105 42 169 124 153
38 7 - 226 142 85 163 120 74 285
172 264 226 - 48 271 15 151 255 116
76 128 142 48 - 189 152 237 183 10
143 105 85 271 189 - 167 193 18 127
155 42 163 15 152 167 - 99 187 59
78 169 120 151 237 193 99 - 51 12
282 124 74 255 183 18 187 51 - 281
58 153 285 116 10 127 59 12 281 -
|
