#!/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.
    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;
}
####################################################################
[download]