#!/usr/bin/perl
use strict;
use warnings;
use Tk;
use Tk::BrowseEntry;
use Tk::Zinc;
use constant OS_Win => $^O =~ /Win/;
my $current; # currently selected shape
my @currentxy; # coordinates of pointer when button clicked
my %objects; # hash of piece IDs => vertex coordinates for each p
+uzzle
my @vertices; # array of the coordinates of all the shapes for sna
+pping
my @puzzles; # array of puzzles read in from DATA file
my $color; # default color of objects
my $block = 50; # puzzle square is 4 x 4 $block pixel
+ blocks
my $screen = 15; # default screen size - in blocks squ
+are
my $selected = 'yellow'; # color of selected object
my $pi4 = atan2( 1, 1 ); # constant pi/4
my $which = 0; # currently loaded puzzle
my $detent = 16; # 'Stops' in a 90 degree rotation
my @colors = qw/bisque cyan green magenta pink red tan/;
{
local $/ = '@@';
while (<DATA>) {
chomp;
s/#.+\n//;
push @puzzles, [ split / *\r?\n/, $_ ] if /\w/;
}
}
my $mw = MainWindow->new();
{ # scale window to fit screen
my $width = $mw->screenwidth;
my $height = $mw->screenheight;
my $square = $height - $width > 0 ? $width : $height;
$block = int( $square * .8 / $screen );
my $dim = $block * $screen;
$mw->geometry( $dim . 'x' . $dim );
}
$mw->Label(
-text => "Fit the pieces together to form a perfect square.\n".
'Left drag to move selected; Mouse Wheel to rotate selected.' )
->pack;
my $zinc = $mw->Zinc(
-borderwidth => 3,
-relief => 'sunken'
)->pack(
-expand => 1,
-fill => 'both',
);
my $buttonbar = $mw->Frame->pack;
my $index = $buttonbar->BrowseEntry(
-label => 'Puzzle #',
-variable => \$which,
-width => 6,
-browsecmd => sub {
del();
load($which);
}
)->grid(
-row => 1,
-column => 1,
-padx => 2,
);
$index->insert( 'end', 0 .. $#puzzles );
$buttonbar->Button(
-text => 'Next',
-width => 10,
-command => sub {
del();
$which++ if $which < $#puzzles;
load($which);
}
)->grid(
-row => 1,
-column => 2,
-padx => 2,
);
$buttonbar->Button(
-text => 'Random',
-width => 10,
-command => sub {
del();
$which = int rand @puzzles;
load($which);
}
)->grid(
-row => 1,
-column => 3,
-padx => 2,
);
my $colorsel = $buttonbar->BrowseEntry(
-label => 'Color',
-variable => \$color,
-width => 10,
-browsecmd => sub {
for ( keys %objects ) {
$zinc->itemconfigure( $_, -fillcolor => $color );
$index->focus;
}
}
)->grid(
-row => 1,
-column => 4,
-padx => 5,
);
$colorsel->insert( 'end', @colors );
$mw->update;
load(0);
$mw->repeat( 100, \&snap );
MainLoop;
sub load {
my $which = shift;
$color = $colors[ int rand @colors ];
my $pattern = $puzzles[$which];
for ( @{$pattern} ) {
my @points;
my ( $repeat, @shape ) = split /\D/, $_;
while ($repeat) {
my $x = int rand($block) + $mw->width / 2;
my $y = int rand($block) + $mw->height / 2;
while (@shape) {
push @points, $x - $block * pop @shape,
$y - $block * pop @shape;
}
$current = $zinc->add(
'curve', 1, [@points],
-closed => 1,
-visible => 1,
-filled => 1,
-fillcolor => $color,
-smoothrelief => 1
);
add_bindings($current);
@currentxy = ( $x, $y );
rotate( ( int rand 32 ) / 4 + 1 );
update_vertices();
$repeat--;
}
}
}
sub del {
$zinc->remove($_) for keys %objects;
%objects = ();
}
sub add_bindings {
my $object = shift;
$zinc->bind( $object, '<Enter>' => sub { choose($object) } );
$zinc->bind( $object, '<Leave>' => sub { unchoose() } );
$zinc->bind( $object, '<1>' => \&click );
$zinc->bind( $object, '<B1-Motion>' => \&mousemove );
}
sub mousemove {
my $ev = $zinc->XEvent();
move( $ev->x - $currentxy[0], $ev->y - $currentxy[1] );
}
sub move {
my ( $x, $y ) = @_;
$zinc->translate( $current, $x, $y );
$currentxy[0] += $x;
$currentxy[1] += $y;
update_vertices();
}
sub update_vertices {
$objects{$current} = '';
$objects{$current} .= "$_->[0],$_->[1] "
for $zinc->transform( $current, 'device', [ $zinc->coords($curre
+nt) ] );
}
sub choose {
$current = shift;
$zinc->itemconfigure( $current, -fillcolor => $selected );
$zinc->raise($current);
update_vertices();
if (OS_Win) {
$mw->bind(
'<MouseWheel>' => [
sub {
click();
rotate( $_[1] / 120 / $detent );
},
Ev('D')
]
);
}
else {
$mw->bind( '<4>' => sub { click(); rotate( 1 / $detent ) } );
$mw->bind( '<5>' => sub { click(); rotate( -1 / $detent ) } );
}
}
sub unchoose {
$zinc->itemconfigure( $current, -fillcolor => $color );
if (OS_Win) {
$mw->bind( '<MouseWheel>' => sub { } );
}
else {
$mw->bind( '<4>' => sub { } );
$mw->bind( '<5>' => sub { } );
}
}
sub click {
my $ev = $zinc->XEvent();
@currentxy = ( $ev->x, $ev->y );
}
sub rotate {
my $angle = shift;
$zinc->rotate( $current, $angle * $pi4 * 2, @currentxy );
update_vertices();
}
sub snap {
my ( @points, $done );
for ( keys %objects ) {
next if $_ eq $current;
push @points, split ' ', $objects{$_};
}
for ( split ' ', $objects{$current} ) {
my ( $x1, $y1 ) = split /,/, $_;
for my $vertex (@points) {
my ( $x2, $y2 ) = split /,/, $vertex;
if ( abs( $x2 - $x1 ) < 8 and abs( $y2 - $y1 ) < 8 ) {
move( $x2 - $x1, $y2 - $y1 );
$done++;
}
last if $done;
}
last if $done;
}
}
# Shapes for puzzles laid out on a 5 x 5 cartesian
# map. Pieces may be slid and rotated as needed.
# Each line represents a shape in the puzzle.
# The first number is the number of times the shape
# appears in the puzzle, the remaining numbers are
# x,y coordinate pairs of each vertex in the shape.
# The 'x' and comma delineators are not critical, any
# non-number separator will work.
__DATA__
#0
2x0,0,4,0,4,4
@@
#1
2x0,0,3,0,3,4,2,4
@@
#2
2x0,0,2,2,0,4
1x0,0,4,0,4,4
@@
#3
2x0,0,2,0,2,2,0,2
1x0,0,4,0,4,2,0,2
@@
#4
1x0,0,4,0,0,2
1x0,0,4,0,4,2
1x0,0,4,2,0,4
@@
#5
4x0,0,4,0,2,2
@@
#6
4x0,0,3,0,2,2,0,1
@@
#7
2x0,0,1,0,1,1,0,1
2x0,0,2,0,2,1,0,1
2x0,0,3,0,3,1,0,1
1x0,0,4,0,4,1,0,1
@@
#8
4x0,0,2,0,0,2
1x2,0,4,2,2,4,0,2
@@
#9
2x0,0,1,0,0,1
2x0,0,3,0,0,3
1x1,0,4,3,3,4,0,1
@@
#10
2x0,0,1,0,0,1
1x0,0,2,0,0,2
1x0,0,2,0,1,1
1x0,0,4,0,2,2
1x0,0,4,4,0,4
@@
#11
2x0,0,2,0,0,1
2x0,0,3,0,0,2
2x2,0,2,4,0,1
@@
#12
4x0,0,1,0,0,1
4x0,0,2,0,1,1
2x1,0,2,1,1,2,0,1
1x1,0,4,3,3,4,0,1
@@
#13
2x0,0,2,0,0,2
4x0,0,2,0,1,1
2x0,2,2,0,3,1,1,3
@@
#14
4x0,0,2,0,0,2
2x0,1,1,0,2,1,1,2
1x0,1,1,0,3,2,2,3
@@
#15
4x0,0,1,0,0,1
4x0,0,2,0,1,1
5x0,1,1,0,2,1,1,2
@@
#16
1x0,0,2,0,2,2,0,2
4x0,0,3,0,3,1,0,1
@@
#17
1x0,0,4,0,0,1
1x0,0,4,0,4,1
3x0,0,4,1,0,2
@@
#18
2x0,0,2,0,0,1
2x0,0,2,0,2,1
2x0,0,2,1,0,2
2x0,1,2,0,4,1,2,2
@@
#19
4x0,0,3,0,3,1
1x0,3,1,0,4,1,3,4
@@
#20
4x0,0,1,0,2,1,0,3
1x0,1,1,0,2,1,1,2
@@
#21
4x0,0,3,0,3,1,1,1,1,2,0,2
@@
#22
4x0,0,3,0,3,1,2,1,2,2,1,2,1,1,0,1
@@
#23
2x0,0,2,0,1,1
1x0,0,2,0,2,2
1x0,0,2,0,3,1,1,1
2x0,0,2,2,0,4
1x0,1,1,0,2,1,1,2
@@
#24
1x0,0,1,0,0,1
3x0,0,1,0,0,2
1x0,0,2,1,2,2,0,1
1x0,0,3,0,2,1
1x0,1,1,0,1,2
1x0,2,1,0,2,1,1,3
1x0,2,1,0,3,1,2,3
@@
#25
2x0,0,1,0,0,2
2x0,0,1,0,2,1,1,1
2x0,0,2,0,2,2
1x0,2,1,0,2,0,1,2
2x0,2,1,0,2,1,1,3
@@
#26
2x0,0,1,0,0,1
1x0,0,1,0,0,3
1x0,0,1,0,1,3
1x0,0,2,0,1,1
1x0,0,2,0,1,3
1x0,1,1,0,2,3,1,4
1x0,3,1,0,2,1,1,4
@@
#27
4x0,0,1,0,3,1,2,2
4x0,0,1,1,0,3
@@
#28
4x0,0,0,1,4,1,4,0
@@
#29
2x0,0,1,2,0,4
4x0,0,2,0,1,2
1x0,2,1,0,2,2,1,4
@@
#30
2x0,0,2,0,0,4
1x0,4,2,0,4,0,2,4
@@
#31
4x0,0,1,0,0,2
2x0,2,1,0,4,0,3,2
@@
#32
2x0,0,1,0,0,2
2x0,0,1,0,1,2
1x0,2,1,0,3,0,4,2,3,4,1,4
@@
#33
2x0,0,1,0,0,2
2x0,4,0,2,1,0,2,0
1x0,4,2,0,4,0,2,4
@@
#34
2x0,0,1,0,0,2
2x0,0,2,0,0,3
1x0,3,2,0,4,1,2,4
@@
#35
2x0,0,1,0,1,1
1x0,0,1,0,1,2,0,2
3x0,0,1,1,0,2
2x0,0,2,0,2,2
1x0,0,3,0,2,1
1x0,1,1,0,2,1,1,2
1x0,1,1,0,3,2,2,2
@@
#36
2x0,0,1,0,0,1
2x0,0,1,0,2,1,0,3
2x0,0,2,0,3,1,1,1
1x0,2,2,0,4,0,2,2
@@
#37
2x0,0,1,0,0,1
3x0,0,1,1,0,2
1x0,0,1,1,1,2,0,1
1x0,0,4,0,2,2
1x0,1,1,0,1,1,0,2
1x0,1,1,0,2,1,1,2
1x0,1,1,0,2,1,2,2,1,3,0,2
@@
#38
1x0,0,1,0,1,1,0,1
1x0,0,1,0,1,2,0,2
1x0,0,1,0,1,3,0,3
1x0,0,2,0,2,2,0,2
1x0,0,2,0,2,3,0,3
@@
#39
1x0,0,1,1,0,2
2x0,0,2,0,2,2
1x0,0,2,0,4,2,2,2
1x0,0,2,2,1,2,0,1
1x0,1,1,0,2,0,0,2
1x0,2,2,0,4,0,2,2
@@
#40
2x0,0,1,0,0,1
2x0,0,1,1,1,2,0,3
2x0,0,3,0,2,1
2x0,1,1,0,3,1,1,2
1x0,1,2,0,2,1,0,2
@@
#41
2x0,0,1,0,1,1
3x0,0,1,1,0,2
1x0,0,3,0,1,1
1x0,0,3,0,2,1
3x0,1,1,0,3,1,1,2
@@
#42
1x0,0,1,0,2,1,1,2,0,2
1x0,0,1,0,2,1,2,2,1,2,0,1
1x0,0,1,1,1,2,0,2
1x0,0,2,0,2,1,1,1
1x0,0,2,0,2,1,1,2,0,1
2x0,0,3,0,2,1,1,1
@@
#43
4x0,0,1,0,2,1,2,2,1,2,0,1
4x0,0,1,1,0,2
@@
#44
1x0,0,0,2,2,2,2,0
4x0,0,1,1,0,2
4x0,0,2,0,0,2
@@
#45
4x0,0,1,1,0,2
1x0,0,2,0,0,2
2x0,0,2,0,3,1,2,2
1x1,0,3,2,2,3,0,1
@@
#46
1x0,0,1,0,2,1,1,2,0,2
2x0,0,1,1,0,2
2x0,0,2,0,1,1,0,1
2x0,0,2,0,2,1,1,1
2x0,1,1,0,2,1,2,2,1,2
@@
#47
1x0,0,0,2,1,3,2,2,2,0
1x0,0,1,0,1,1,0,1
1x0,0,1,0,2,1,0,1
1x0,0,1,0,2,1,1,2,0,1
2x0,0,2,0,1,1,0,1
1x0,0,2,0,2,1,1,2,0,1
@@
#48
1x0,0,1,0,0,1
1x0,0,1,0,1,1,0,1
1x0,0,1,0,1,1,0,2
1x0,0,1,0,1,2,0,3
1x0,0,1,0,1,3,0,4
1x0,0,1,1,0,2
1x0,0,2,0,0,2
1x0,0,2,2,0,4
@@
#49
1x0,0,1,0,1,1,0,1
1x0,0,1,0,1,1,0,2
1x0,0,1,0,1,2,0,1
1x0,0,2,0,0,2
4x0,1,1,2,2,1,2,0,1,0
@@
#50
1x0,0,3,0,0,3
1x0,3,3,0,3,3
1x0,3,3,0,4,0,0,4
1x0,4,4,0,4,1,1,4
@@
#51
2x0,0,0,1,1,0
1x0,3,3,0,4,0,0,4
1x0,4,4,0,4,1,1,4
2x1,0,2,0,0,2,0,1
2x2,0,3,0,0,3,0,2
@@
#52
1x2,0,3,2,0,2,0,1
1x0,0,4,0,2,2
1x0,0,2,0,2,2,1,2
1x0,0,2,2,0,3
1x2,0,2,2,0,2
@@
#53
2x0,0,1,1,1,3,0,4
2x0,0,3,0,2,1,1,1
2x0,0,1,0,0,1
1x0,2,0,3,1,3,3,1,3,0,2,0
@@
#54
2x0,0,2,0,2,1,1,1,1,2,0,2
2x0,0,2,0,2,1,1,1,1,4,0,4
@@
#55
2x0,0,2,0,2,1,1,1,1,2,0,2
1x0,0,2,0,2,1,1,1,1,4,0,4
1x0,0,3,0,3,1,1,1,1,3,0,3
@@
#56
1x0,0,4,0,4,1
1x0,0,4,1,4,2
1x0,0,4,2,4,3
1x0,0,4,3,4,4,3,4
1x0,0,3,4,0,1
1x0,0,3,3,0,1
1x0,0,3,2,0,1
1x0,0,3,1,0,1
@@
#57
2x0,0,1,0,3,2,1,2,0,1
2x0,0,3,0,3,1,1,1
2x0,0,2,0,2,2
@@
#58
1x0,0,0,3,3,0
2x0,0,0,1,1,2,2,1,1,0
2x0,0,1,1,2,0
1x0,0,1,1,1,0
1x0,0,0,1,1,1,1,0
1x0,1,2,3,2,2,3,2,1,0,1,1
@@
#59
2x0,0,0,1,1,2,1,0
2x0,0,0,1,1,0
4x0,0,1,1,2,1,3,0
2x0,0,0,2,2,2
@@
#60
1x0,0,2,0,2,1,1,1
1x0,0,2,0,1,1,0,1
1x0,0,1,0,2,1,1,1,1,2,0,1
1x0,0,1,0,2,1,2,2,1,2,0,1
4x0,0,3,0,2,1,1,1
@@
#61
1x0,0,1,0,3,2,1,2,0,1
1x0,0,3,0,3,1,2,2
1x0,0,2,0,1,1
1x0,0,1,0,2,1,2,2,1,2,0,1
1x0,0,3,0,2,1,1,1
1x0,0,3,0,2,1,2,2,1,2,1,1
@@
#62
1x0,0,4,0,4,1,1,1
1x0,0,1,1,2,1,2,2,1,2,0,3
1x0,0,1,0,1,1
1x0,0,2,0,2,2
2x0,0,3,0,3,1,2,2
@@
#63
1x0,0,2,0,1,1
1x0,0,1,1,1,2,0,1
1x0,0,2,0,3,1,1,1
1x0,0,1,0,2,1,2,2,1,2,0,1
3x0,0,1,1,2,1,2,2,1,2,0,3
@@
#64
2x0,0,1,0,0,1
2x0,0,2,0,1,1
2x0,0,2,0,2,1,1,1
4x0,0,1,0,2,1,1,1
6x0,0,1,1,1,2,0,1
@@
#65
2x0,0,1,0,0,1
1x0,0,1,1,0,2
1x1,0,3,2,1,4,0,3,1,2,0,1
2x0,0,3,0,2,1,1,1
1x0,0,2,0,2,1,1,2,1,1
1x0,0,2,0,1,1,1,2,0,1
@@
#66
1x0,0,4,0,4,1,3,2,2,1,1,1
2x0,0,2,0,1,1,1,2,0,1
1x0,0,2,0,2,1,1,2,1,1
1x0,0,1,0,1,2,0,1
1x1,0,1,1,2,2,1,3,1,2,0,1
1x1,0,2,1,2,2,1,1,1,2,0,1
@@
#67
1x0,0,2,0,2,1,4,3,2,3,2,2
1x0,0,1,1,0,2
1x0,0,2,2,2,3,0,1
1x0,0,2,0,2,2
1x0,0,1,1,1,2,0,1
1x1,0,1,1,2,2,1,3,1,2,0,1
1x0,0,2,0,1,1,0,1
1x0,0,3,0,2,1,0,1
@@
#68
1x0,0,1,0,1,1
2x0,0,2,0,2,2,1,1,0,2
3x1,0,2,1,1,1,1,2,0,1
1x0,0,2,0,2,2,1,2,1,1
1x0,0,2,0,1,1,1,2,0,2
@@
#69
1x0,0,1,0,0,1
1x0,0,2,0,1,2,0,1
1x0,0,2,0,2,2,0,1
1x0,0,2,0,2,2,1,1,0,2
1x0,0,1,0,1,2,0,2
1x0,0,2,0,0,2
1x1,0,1,1,3,3,2,4,2,3,0,1
@@
#70
1x0,0,1,0,1,1
1x1,0,2,1,1,2,0,1
1x0,0,3,0,1,1
2x0,0,3,0,2,1
2x0,0,2,1,0,2
1x0,0,2,0,0,3
1x0,0,2,0,3,2
@@
#71
2x0,0,2,0,1,2
2x0,0,4,0,2,1
4x0,0,3,2,1,2
@@
#72
1x0,0,2,0,0,4
1x0,0,2,0,1,2
1x0,0,4,0,2,1
1x0,0,4,0,3,2
1x0,0,3,2,2,4
@@
#73
1x0,0,2,0,3,1,1,1
2x0,0,2,0,1,1,1,2,0,1
2x0,0,2,0,2,1,1,2,1,1
1x0,0,1,0,1,2,0,1
1x1,0,1,1,2,2,1,3,1,2,0,1
1x1,0,2,1,2,2,1,1,1,2,0,1
1x0,0,1,0,0,1
@@
#74
1x0,0,2,0,1,1,1,2,0,1
4x0,0,2,0,2,1,1,2,1,1
1x0,0,1,0,0,1
1x1,0,2,1,3,1,2,2,1,1,0,1
1x0,0,1,0,1,1,0,1
1x0,0,2,0,1,1,0,1
1x0,0,1,1,1,2,0,1
@@
#75
1x0,0,1,0,0,1
1x1,0,2,1,3,1,2,2,1,1,0,1
1x0,0,2,0,2,1,1,1
1x0,0,2,0,2,2,1,1,0,1
1x0,0,2,0,0,2
1x0,0,4,0,4,1,2,1,2,2
1x0,0,2,0,2,1,1,2,0,2
@@
#76
1x0,0,1,0,1,2
1x0,0,1,2,0,3
1x0,0,3,0,0,1
1x0,0,2,0,1,3
1x0,0,2,0,0,2
1x0,0,1,2,1,3
1x0,0,2,0,1,2
1x0,0,1,0,2,1
1x1,0,3,2,0,3
@@
#77
2x0,0,1,0,2,1,2,2,1,2,1,1
2x0,0,1,0,2,1,2,2,1,1,0,1
1x0,0,3,0,2,1,1,1
1x0,0,1,0,2,1,1,1
1x0,0,1,0,1,1,0,1
1x1,0,2,0,0,2,0,1
1x0,0,2,0,0,2
1x0,0,1,0,0,1
@@
#78
1x0,0,2,0,1,1,1,2,0,3
1x0,0,2,0,2,1,1,1,1,2,0,1
1x0,0,2,0,2,2,1,1,0,1
1x0,0,1,0,1,2
1x0,0,1,2,1,3,0,2
1x0,0,1,0,1,1,2,2,1,2,0,1
1x0,0,1,1,2,1,1,2,0,1
1x1,0,1,1,2,2,1,3,1,2,0,1
@@
#79
2x0,0,2,0,2,2,1,1,0,1
2x0,0,2,0,2,1,1,1,0,2
1x0,0,1,0,1,1,0,1
1x0,0,3,0,3,1,2,2,2,1,1,1
1x0,0,1,1,1,3,0,2
@@
#80
1x0,0,4,0,2,2
1x0,0,2,0,2,2
1x0,0,4,0,3,1,1,1
1x0,0,2,0,2,2,1,3,1,1
2x0,0,1,1,1,3,0,2
@@
#81
2x0,0,2,0,3,1,2,2
1x1,0,3,0,1,2,0,1
2x0,0,2,0,1,1,2,2,0,2
1x0,0,2,0,1,1
@@
|