Syntactic Confectionery Delight PerlMonks

### Tk Patio/Office layout designer

by zentara (Archbishop)
 on Sep 06, 2006 at 16:08 UTC Need Help??
 Description: This is an attempt to improve on Re: Challenge: 2D random layout of variable-sized rectangular units.. After some experimentation with rotations, and collision detection, I finally came to the conclusion that collision detection wasn't robust enough. Why? First, the overlap detection only works on rectangular regions. This prevents circular pavers, and triangular cut pavers from working with collision detection. Second, the amount of computation needed to detect overlaps on each incremental move, sometimes caused "lack of smooth dragging and rotating". So bye-bye collision detection. I did add arbitrary rotation in 15 degree increments, and added circles.This probably could be useful in planning a patio, office layout, or even a garden. One note of interest, is that to get arbitrary rotations, rectangles and triangles, must be plotted as polygons, where each vertex is defined. See Ala Qumsieh's Tk-RotCanvas
```#!/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 wit
+h 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::exi
+t(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{\$pav
+er}->[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', '<B1-Motion>', sub {&mobileMove();});
\$canvas->bind('move', '<ButtonRelease-1>', 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','<Shift-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);
});

#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.

# 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;
}
####################################################################

```

Create A New User
Node Status?
node history
Node Type: snippet [id://571493]
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (8)
As of 2018-06-19 14:24 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
Should cpanminus be part of the standard Perl release?

Results (114 votes). Check out past polls.

Notices?