#!/usr/bin/perl use warnings; use strict; use Tk; # USAGE: \$0 x-dimension y-dimension # in meters e.g. \$0 8.65 4.1 # Your going to lay a patio using brand of precast concrete # "stone effect" pavers that come in a range of sizes: # in centimeters to make screen sizing easier, 1 cm per pixel # we need the rectangles to be created as polygons because # rotations of arbitrary degrees need every vertex identified # r for rectangular, c for circles my %ss = ( 'a' => [30,30,'hotpink','r'], 'b' => [45,30,'red','r'], 'c' => [45,45,'lightblue','r'], 'd' => [60,45,'pink','r'], 'e' => [60,60,'grey70','r'], 'f' => [60,30,'lightgreen','r'], 'g' => [75,60,'wheat1','r'], 'h' => [75,75,'khaki','r'], 'i' => [90,60,'plum1','r'], 'j' => [30,30,'lightsteelblue','c'], 'k' => [45,45,'lightsteelblue','c'], 'l' => [60,60,'lightsteelblue','c'], 'm' => [90,90,'lightsteelblue','c'], ); # print \$ss{'a'}->[0] , \$ss{'a'}->[1], \$ss{'a'}->[2],"\n"; # print @{ \$ss{'a'} },"\n"; #The size of the patio as input can be 'rounded up' in either #or both dimensions to the next of the greatest #common divisor (GCD) of the list of sizes. #(This puts all cuts to be made in the actual #patio at one of the four edges). #For example. The GCD of the 9 sizes above is 150mm. #This forms a minimum grid for the layout. If the patio size #entered was 8.65 x 4.1, then this would be round up to # my \$patio_xin = 8.65; # my \$patio_yin = 4.1; # my \$patio_x = 0.15 * ( 1 + int( \$patio_xin / 0.15 ) ); # my \$patio_y = 0.15 * ( 1 + int( \$patio_yin / 0.15 ) ); # print "\$patio_x \$patio_y\n"; # 8.7 x 4.2 my \$patio_xin = shift || 8.65; my \$patio_yin = shift || 4.1; my \$patio_x = 0.15 * ( 1 + int( \$patio_xin / 0.15 ) ); my \$patio_y = 0.15 * ( 1 + int( \$patio_yin / 0.15 ) ); my \$dx; #globals used for dragging my \$dy; my \$ptag; my \$patio; my \$mw = MainWindow->new; \$mw->fontCreate('big', -family=>'arial', -weight=>'bold', -size=>int(-18*18/14)); my \$topframe = \$mw->Frame(-bg=>'black')->pack(-fill=>'x'); \$topframe->Label(-text=>"X-Y = \$patio_x - \$patio_y (rounded)", -bg => 'black', -fg => 'lightblue', -font => 'big', )->pack(-side=>'left'); \$topframe->Label(-text=>' ', -bg => 'black', )->pack(-side=>'left'); \$topframe->Label(-text=>'Drag pavers with left button, rotate them with a right (or shift-right)click', -bg => 'black', -fg => 'lightgreen', )->pack(-side=>'left'); my \$S_canvas = \$mw->Scrolled('Canvas', -width => 600, -height => 600, -bg => 'grey40', -borderwidth => 0, -relief => 'sunken', -scrollbars => 'osoe', -scrollregion => [ 0, 0, 1000, 1000 ], )->pack(-expand => 1, -fill =>'both'); my \$canvas = \$S_canvas->Subwidget('scrolled'); my \$closebutton = \$mw->Button(-text => 'Exit', -command => sub{Tk::exit(0)}) ->pack; my \$x0 = 20; #slight offset my @count = reverse(1..99); foreach my \$num (@count){ foreach my \$paver ('a'..'m'){ my(\$x,\$y,\$color,\$type) = @{ \$ss{ \$paver } }; # print "\$x,\$y,\$color,\$type\n"; # \$canvas->createRectangle(\$x0, 0, \$x0 + \$x, \$y, if(\$type eq 'r'){ \$canvas->createPolygon( \$x0, 0, \$x0 + \$x, 0, \$x0 + \$x, \$y, \$x0, \$y, \$x0, 0, -fill => \$color, -tags => ['move', "\$paver\$num".'p', 'paver'], -width => 0, ); } if(\$type eq 'c'){ \$canvas->createOval( \$x0, 0, \$x0 + \$x, \$y, -fill => \$color, -tags => ['move', "\$paver\$num".'p', 'paver'], -width => 0, ); } \$canvas->createText(\$x0 + (\$x/2) , \$y/2, -anchor=>'center', -fill => 'black', -text => " \$paver\$num\n".(\$ss{\$paver}->[0]).'x'.(\$ss{\$paver}->[1]), -tags => ['move', "\$paver\$num".'t', 'paver'], ); \$x0 += \$x; } \$x0 = 20; } # rectangle to simulate patio for dragging pavers to \$canvas->createRectangle(15, 120, 15+\$patio_x*100, 120 + \$patio_y*100, -fill => 'black', -outline => 'white', -width => 2, -tags => ['patio'], ); \$canvas->lower('patio', 'paver'); \$canvas->configure(-width => \$patio_x * 100 + 20, -height=> \$patio_y * 100 + 130); \$canvas->configure(-scrollregion => [0,0,\$patio_x * 100 + 120,\$patio_y * 100 + 250]); \$canvas->bind('move', '<1>', sub {&mobileStart();}); \$canvas->bind('move', '', sub {&mobileMove();}); \$canvas->bind('move', '', sub {&mobileStop();}); \$canvas->bind('paver','<3>', sub { my(@tags) = \$canvas->gettags("current"); @tags = grep{/^\w{1}\d+[pt]\$/} @tags; chop \$tags[0]; #pull off t or p my \$ptag = \$tags[0]; &rotate_poly(\$ptag,-15,undef,undef); }); \$canvas->bind('paver','', sub { my(@tags) = \$canvas->gettags("current"); @tags = grep{/^\w{1}\d+[pt]\$/} @tags; chop \$tags[0]; #pull off t or p my \$ptag = \$tags[0]; &rotate_poly(\$ptag,15,undef,undef); }); #postscript save \$topframe->Button( -text => "Save as postscript", -command => [sub { \$canvas->update; my @capture=(); my (\$x0,\$y0,\$x1,\$y1)=\$canvas->bbox('all'); \$y0 = 120; #lop off paver stacks @capture=('-x'=>\$x0,'-y'=>\$y0,-height=>\$y1-\$y0,-width=>\$x1-\$x0); my \$filename = \$patio_x.'-'.\$patio_y.'--'.time.'.ps'; \$canvas->postscript(-colormode=>'color', -file=> \$filename, -rotate=>0, -width=>\$patio_x + 100, -height=>\$patio_y + 100, @capture); } ] )->pack; MainLoop; ##################################################### sub mobileStart { my \$ev = \$canvas->XEvent; (\$dx, \$dy) = (0 - \$ev->x, 0 - \$ev->y); my(@tags) = \$canvas->gettags("current"); @tags = grep{/^\w{1}\d+[pt]\$/} @tags; chop \$tags[0]; #pull off t or p \$ptag = \$tags[0]; # print "\$ptag\n"; \$canvas->raise(\$ptag.'p'); \$canvas->raise(\$ptag.'t'); #keep text showing # print "START MOVE-> \$dx \$dy\n"; } ############################################################ sub mobileMove { return if (\$ptag eq ''); my \$ev = \$canvas->XEvent; my \$y = \$ev->y; foreach(\$ptag.'p', \$ptag.'t'){ \$canvas->move(\$_, \$ev->x + \$dx, \$ev->y +\$dy); } (\$dx, \$dy) = (0 - \$ev->x, 0 - \$ev->y); } ############################################################## sub mobileStop{ \$ptag = '' } ############################################################# sub rotate_poly { my (\$tag, \$angle, \$midx, \$midy) = @_; #taken from Ala Qumsieh's ROTCanvas module \$tag = \$tag.'p'; return if(\$canvas->type(\$tag) eq 'oval'); # Get the old coordinates. my @coords_in = \$canvas->coords(\$tag); my @old = @coords_in; # Get the center of the poly. We use this to translate the # above coords back to the origin, and then rotate about # the origin, then translate back. (old) (\$midx, \$midy) = _get_CM(@coords_in) unless defined \$midx; my @new; # Precalculate the sin/cos of the angle, since we'll call # them a few times. my \$rad = 3.1416*\$angle/180; my \$sin = sin \$rad; my \$cos = cos \$rad; # Calculate the new coordinates of the line. while (my (\$x, \$y) = splice @coords_in, 0, 2) { my \$x1 = \$x - \$midx; my \$y1 = \$y - \$midy; push @new => \$midx + (\$x1 * \$cos - \$y1 * \$sin); push @new => \$midy + (\$x1 * \$sin + \$y1 * \$cos); } # Redraw the poly. \$canvas->coords(\$tag, @new); } ################################################################# # This sub finds the center of mass of a polygon. # I grabbed the algorithm somewhere from the web. # I grabbed it from Ala Qumsieh's RotCanvas :-) sub _get_CM { my (\$x, \$y, \$area); my \$i = 0; while (\$i < \$#_) { my \$x0 = \$_[\$i]; my \$y0 = \$_[\$i+1]; my (\$x1, \$y1); if (\$i+2 > \$#_) { \$x1 = \$_[0]; \$y1 = \$_[1]; } else { \$x1 = \$_[\$i+2]; \$y1 = \$_[\$i+3]; } \$i += 2; my \$a1 = 0.5*(\$x0 + \$x1); my \$a2 = (\$x0**2 + \$x0*\$x1 + \$x1**2)/6; my \$a3 = (\$x0*\$y1 + \$y0*\$x1 + 2*(\$x1*\$y1 + \$x0*\$y0))/6; my \$b0 = \$y1 - \$y0; \$area += \$a1 * \$b0; \$x += \$a2 * \$b0; \$y += \$a3 * \$b0; } return split ' ', sprintf "%.0f %0.f" => \$x/\$area, \$y/\$area; } ####################################################################