Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
#!/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 @@

In reply to Tk::Zinc based geometry puzzles by thundergnat

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others exploiting the Monastery: (3)
As of 2024-04-25 19:14 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found