#!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 -
[download]