#! /usr/bin/perl -w
#use strict;
use Tk;
my $status = "waiting for action...";
my ($width, $height) = (700, 600);
my ($startX, $startY) = (50, 50);
my ($lStartX, $lStartY) = (10, 10);
my $rectangles = {};
my $i = 0;
my $move = {};
my $psFile = "";
my $mw = MainWindow->new(-title => "Canvas");
$frameMenu = $mw->Frame( -relief => 'sunken', -borderwidth => 2)
->pack( -side => 'top', -fill => 'x');
$frameCanvas = $mw->Frame()
->pack( -side => 'top', -fill => 'both', -expand => 1);
$frameStatus = $mw->Frame( -relief => 'sunken', -borderwidth => 2)
->pack( -side => 'bottom', -fill => 'x');
$frameStatus->Label( -text => 'Status: ', -borderwidth => 1,
-relief => 'raised')
->pack( -side => 'left');
$frameStatus->Label( -textvariable => \$status )
->pack( -side => 'left');
my $psButton = $frameMenu->Button( -text => "Postscriptdatei erstellen",
-command => \&GetPSFilename )
->pack( -side => 'right');
$createRoomButton = $frameMenu->Button( -text => "CreateRoom",
-command => \&CreateRoom_GetLaenge )
->pack( -side => 'left');
$canvas = $frameCanvas->Canvas( -width => $width, -height => $height,
-background => 'yellow', -cursor => 'crosshair')
->pack ( -side => 'top', -fill => 'both', -expand => 1);
$canvas->Tk::bind("<ButtonPress-1>", [ \&ButtonDown, Ev('x'), Ev('y') ] );
$canvas->Tk::bind("<ButtonRelease-1>", [ \&ButtonUp, Ev('x'), Ev('y') ] );
$canvas->Tk::bind("<Button-2>", [ \&Button2Click, Ev('x'), Ev('y') ] );
$createRoomButton->focus();
MainLoop();
# ------------------------------------------------------------
sub WriteInputField {
my ($lText, $var, $proc) = @_;
$label = $frameMenu->Label( -text => $lText)
->pack( -side => 'left');
$entry = $frameMenu->Entry( -textvariable => \$_[1])
->pack( -side => 'left');
$entry->focus();
$button = $frameMenu->Button( -text => "Save",
-command => $proc )
->pack( -side => 'left' );
$entry->bind("<Return>", $proc);
return ($label, $entry, $button);
} # WriteInputField
# ------------------------------------------------------------
sub CreateRoom_GetLaenge {
$roomLaenge = "";
$createRoomButton->configure( -state => 'disabled');
my ($label, $entry, $button)= &WriteInputField
("Laenge eingeben in cm: ", $roomLaenge, \&CreateRoom_GetBreite);
} # CreateRoom_GetLaenge
# ------------------------------------------------------------
sub CreateRoom_GetBreite {
$roomLaenge =~ /(\d+)/; $roomLaenge = $1;
if ($roomLaenge){
$_->destroy() foreach ($label, $entry, $button);
my ($label, $entry, $button) = &WriteInputField
("Breite eingeben in cm: ", $roomBreite, \&CreateRoom_DrawRoom);
} # if
else {
print ("Bitte einen numerischen Wert eingeben\n");
$entry->focus();
} # else
} # CreateRoom_GetBreite
# ------------------------------------------------------------
sub CreateRoom_DrawRoom {
$roomLaenge =~ /(\d+)/; $roomLaenge = $1;
if ($roomLaenge){
$_->destroy() foreach ($label, $entry, $button);
$endX = $startX + $roomBreite;
$endY = $startY + $roomLaenge;
$canvas->createRectangle($startX, $startY, $endX, $endY,
-fill => 'white');
for ($startX..$endX){
if (($_-$startX) % 50 == 0){
$canvas->createLine($_, $startY, $_, $endY, -width => 2);
}
elsif (($_-$startX) % 10 == 0){
$canvas->createLine($_, $startY, $_, $endY);
}
}
for ($startY..$endY){
if (($_-$startY) % 50 == 0){
$canvas->createLine($startX, $_, $endX, $_, -width => 2);
}
elsif (($_-$startY) % 10 == 0){
$canvas->createLine($startX, $_, $endX, $_);
} # elsif
}
$addRectangleButton = $frameMenu->Button
( -text => 'Add Rectangle', -command => \&CreateRect_GetLaenge)
->pack( -side => 'left');
$addRectangleButton->focus();
} # if
else {
print ("Bitte einen numerischen Wert eingeben\n");
$entry->focus();
} # else
} # CreateRoom_DrawRoom
# ------------------------------------------------------------
sub CreateRect_GetLaenge {
$addRectangleButton->configure( -state => 'disabled' );
my ($label, $entry, $button) = &WriteInputField
("Laenge eingeben in cm: ", $rectLaenge, \&CreateRect_GetBreite);
} # GetRectangleLength
# ------------------------------------------------------------
sub CreateRect_GetBreite {
$rectLaenge =~ /(\d+)/; $rectLaenge = $1;
if ($roomLaenge){
$_->destroy() foreach ($label, $entry, $button);
my ($label, $entry, $button) = &WriteInputField
("Breite eingeben in cm: ", $rectBreite, \&CreateRect_Draw);
} # if
else {
$rectLaenge = "";
print ("Bitte einen numerischen Wert eingeben\n");
$entry->focus();
} # else
} # CreateRect_GetBreite
# ------------------------------------------------------------
sub CreateRect_Draw {
$rectBreite =~ /(\d+)/; $rectBreite = $1;
if ($rectBreite){
$_->destroy() foreach ($label, $entry, $button);
$rectangles->{$i}->{laenge} = $rectLaenge;
$rectangles->{$i}->{breite} = $rectBreite;
$rectangles->{$i}->{xpos} = $lStartX;
$rectangles->{$i}->{ypos} = $lStartY;
$rectangles->{$i}->{rectAngle} =
$canvas->createRectangle($lStartX, $lStartY,
$lStartX + $rectBreite,
$lStartY + $rectLaenge,
-fill => 'blue');
$addRectangleButton->configure( -state => 'normal' );
$rectLaenge = "";
$rectBreite = "";
$i++;
} # if
else {
print ("Bitte einen numerischen Wert eingeben\n");
$entry->focus();
}
} # CreateRect_Draw
# ------------------------------------------------------------
sub ButtonDown {
my ($canv, $x, $y) = @_;
$move->{x1} = $canv->canvasx($x); $move->{y1} = $canv->canvasx($y);
$move->{x2} = ""; $move->{y2} = "";
} # ButtonDown
# ------------------------------------------------------------
sub Button2Click {
my ($canv, $x, $y) = @_;
$move->{x1} = $canv->canvasx($x); $move->{y1} = $canv->canvasx($y);
if ($move->{x1} and $move->{y1}){
my $i = &GetSelectedItem($move, $rectangles);
$canvas->delete($rectangles->{$i}->{rectAngle});
undef $rectangles->{$i};
print ("Deleted rectangle $i\n");
$move->{x1} = ""; $move->{y1} = "";
} # if
} # Button2Click
# ------------------------------------------------------------
sub ButtonUp {
my ($canv, $x, $y) = @_;
$move->{x2} = $canv->canvasx($x); $move->{y2} = $canv->canvasx($y);
# print ("Movement from $move->{x1}/$move->{y1} to $move->{x2}/$move->{y2}\n");
&MoveItem($move);
$move->{x1} = ""; $move->{x2} = ""; $move->{y1} = ""; $move->{y2} = "";
} # ButtonUp
# ------------------------------------------------------------
sub MoveItem {
my ($form) = shift;
my $i = &GetSelectedItem($form, $rectangles);
if (defined($i)){
my $moveX = $form->{x2} - $form->{x1};
my $moveY = $form->{y2} - $form->{y1};
# print ("Moving $i by $moveX/$moveY\n");
$rectangles->{$i}->{xpos} += $moveY;
$rectangles->{$i}->{ypos} += $moveX;
$canvas->move($rectangles->{$i}->{rectAngle}, $moveX, $moveY);
$i = undef;
}
} # MoveForm
# ------------------------------------------------------------
sub GetSelectedItem {
my ($form, $rectangles) = @_;
foreach my $ra (keys %$rectangles){
my ($rx1) = $rectangles->{$ra}->{xpos};
my ($ry1) = $rectangles->{$ra}->{ypos};
next unless defined $rx1;
next unless defined $ry1;
my ($rx2) = $rectangles->{$ra}->{laenge} + $rx1;
my ($ry2) = $rectangles->{$ra}->{breite} + $ry1;
if (&CoordinatesAreWithinRectangle( $form->{x1}, $form->{y1},
$rx1, $ry1, $rx2, $ry2 )){
return ($ra);
} # if
} # foreach
return (undef);
} # GetSelectedItem
# ------------------------------------------------------------
sub CoordinatesAreWithinRectangle {
my ($y, $x, $rx1, $ry1, $rx2, $ry2) = @_;
if ($x >= $rx1 and $x <= $rx2){
if ($y >= $ry1 and $y <= $ry2){
return 1;
}
}
return 0;
} # CoordinatesAreWithinRectangle
# ------------------------------------------------------------
sub GetPSFilename {
$psButton->configure( -state => 'disabled');
$label = $frameMenu->Label( -text => "Dateinamen angeben: ")
->pack( -side => 'left');
$entry = $frameMenu->Entry( -textvariable => \$psFile )
->pack( -side => 'left');
$entry->bind("<Return>", \&MakePSFile );
$button = $frameMenu->Button( -text => "Save",
-command => \&MakePSFile)
->pack( -side => 'left');
$entry->focus();
} # GetPSFilename
# ------------------------------------------------------------
sub MakePSFile {
$_->destroy foreach ($label, $entry, $button);
if (-e $psFile){
unlink($psFile);
}
$canvas->postscript( -file => $psFile );
$psButton->configure( -state => 'normal');
}