Tk-Raten: Linie zwischen zwei Boxen ziehen (Graphische Oberflächen)

[thread]15443[/thread]

Tk-Raten: Linie zwischen zwei Boxen ziehen

Leser: 18

Articles: hide open all | hide show old branches

+4 replies

pktm

2010-09-05 16:05

User since
2003-08-07
2921 Artikel
BenutzerIn

Liebe alle!

Es gab ja mal das Rätsel der Woche. Das hier ist eventuell für den ein oder anderen sowas ähnliches :)

Hier eine Aufgabenstellung, an der ich mich gerade versuche:

Gegeben eine Canvas, die zwei Boxen enthält, die Text enthalten.
Zwischen diesen beiden Boxen soll man nun eine Linie ziehen können.

Dazu soll der Nutzer auf eine Box klicken können, die Maustaste gedrückt halten und auf der anderen Box loslassen. Im Prinzip ist das drag&drop oder?
Wenn die Maus irgendwo losgelassen wird, wo keine Box ist, oder Ausgangsbox und Zielbox identisch sind, dann soll die Linie nicht gemalt werden.
Ich möchte natürlich wissen, welche beiden Boxen miteinander verbunden wurden.
Eine Ausgabe mit print() reicht dazu erstmal.

Es sollte egal sein, ob an eine Box auf der linken Seite mit einer auf der rechten Seite verbindet oder andersherum. Allerdings soll es nur möglich sein, zwei verschiedene Seiten miteinander zu verbinden. Die Information, auf welcher Seite eine Box steht, wird über ein Tag markiert (left / right).

Code (perl): (dl )

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper qw/Dumper/;
use Tk;

my $mw = tkinit();

my $c = $mw->Canvas()->pack(-expand => 1, -fill => 'both',);

# -------------------------------------------------------------
# --- left box
my $left = $c->createText(
        50, 50,
        -text => 'left',
        -tags => [qw/left text id1/]
);
my @left_bbox = $c->bbox('left', 'id1');
my $padding = 3;
$c->createRectangle(
        $left_bbox[0] - $padding, $left_bbox[1] - $padding,
        $left_bbox[2] + $padding, $left_bbox[3] + $padding,
        -fill => 'green',
        -tags => [qw/left box id1/]
);
$c->raise('text', 'box');

# -------------------------------------------------------------
# --- right box
my $right = $c->createText(
        250, 50,
        -text => 'right',
        -tags => [qw/right text id5/]
);
my @right_bbox = $c->bbox('right', 'id5');
$c->createRectangle(
        $right_bbox[0] - $padding, $right_bbox[1] - $padding,
        $right_bbox[2] + $padding, $right_bbox[3] + $padding,
        -fill => 'yellow',
        -tags => [qw/right box id5/]
);
$c->raise('text', 'box');


$mw->MainLoop();

Vielleicht mag ja wer mitraten, wie das geht. Mich würden auch Lösungen mit anderen GUI-Systemen interessieren, z.B. Wx-Widgets oder GTk2.
Wenn ich eine Lösung fertig habe, poste ich sie hier.

http://www.intergastro-service.de (mein erstes CMS :) )

+2 replies

Molaf

2010-09-06 11:58

User since
2007-10-11
119 Artikel
BenutzerIn
[default_avatar]

Ich habe sowas schonmal mit Tk/Canvas gemacht, allerdings habe ich den Code grad nicht zur Hand.

D&D habe ich keinen Plan von, deswegen habe ich beim Mausklick eine Subfunktion aufgerufen, die prüft ob ein Element des Canvas berührt wird. das Canvas selbst stellt ein Tag bereit, wenn die Maus etwas berührt (ersatzweise kann man sich in einer extra Datenstruktur die Positionen der Boxen merken und selbst durchsehen, ob die Maus sich innerhalb der Grenzen befindet.).

Das ganze dann nochmal beim Maus-Release und schon hat man es.

Heute abend könnte ich nochmal nach dem Code suchen, wenn es bis dahin noch nichts Lauffähiges gibt.

Gruß,
Molaf

pktm

2010-09-06 20:42

User since
2003-08-07
2921 Artikel
BenutzerIn

Hallo Molaf,

den Code würde ich mir gerne mal ansehen.

Hier ist das, was ich gestern Abend und heute Abend so hinbekommen habe.
Der Code zum Auslesen einer ID, die als Tag hinterlegt wurde, muss noch gekapselt werden, aber ich denke, damit komme ich ganz gut hin.

Es fehlt noch:
- diese Kapselung...
- Ursprungs-Widget-ID merken
- Linie zwischen den Widgets malen (ich will die gezogene nicht einfach stehen lassen, sondern eine ordentliche von der Mitte rechten Randes des linken Widgets zur Mitte des linken Rands des rechten Widgets ziehen).

Code (perl): (dl )

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper qw/Dumper/;
use Tk;

my $mw = tkinit();

my $canvas = $mw->Canvas()->pack(-expand => 1, -fill => 'both',);

# -------------------------------------------------------------
# --- left box
my $left = $canvas->createText(
        50, 50,
        -text => 'left',
        -tags => [qw/left text id1/]
);
my @left_bbox = $canvas->bbox('left', 'id1');
my $padding = 3;
$canvas->createRectangle(
        $left_bbox[0] - $padding, $left_bbox[1] - $padding,
        $left_bbox[2] + $padding, $left_bbox[3] + $padding,
        -fill => 'green',
        -tags => [qw/left box id1/]
);
$canvas->raise('text', 'box');

# -------------------------------------------------------------
# --- right box
my $right = $canvas->createText(
        250, 50,
        -text => 'right',
        -tags => [qw/right text id5/]
);
my @right_bbox = $canvas->bbox('right', 'id5');
$canvas->createRectangle(
        $right_bbox[0] - $padding, $right_bbox[1] - $padding,
        $right_bbox[2] + $padding, $right_bbox[3] + $padding,
        -fill => 'yellow',
        -tags => [qw/right box id5/]
);
$canvas->raise('text', 'box');


# -- store point of origin here:
my $origin_x = undef;
my $origin_y = undef;


$canvas->bind('left', '<Button-1>' , [ 
        sub{ start_drawing_xy(@_); }, 
        Ev('x'), Ev('y'), 
        \$origin_x, \$origin_y 
]);
$canvas->Tk::bind('<B1-Motion>' , [ 
        sub{ motion_xy(@_); }, 
        Ev('x'), Ev('y'), 
        \$origin_x, \$origin_y 
]);
$canvas->Tk::bind('<ButtonRelease>' , [ 
        sub{ stop_drawing_xy(@_); }, 
        Ev('x'), Ev('y'), 
        \$origin_x, \$origin_y 
]);

$mw->MainLoop();


=head2 start_drawing_xy( $canvas, $x, $y, \$origin_x, \$origin_y )

=cut

sub start_drawing_xy {
        my $canvas = shift;
        my $x = shift;
        my $y = shift;
        my $origin_x = shift;
        my $origin_y = shift;
        
        $$origin_x = $x;
        $$origin_y = $y;
        
        printf("init drawing from vertex <%s, %s>\n", $x, $y);
} # /start_drawing_xy




=head2 motion_xy( $canvas, $x, $y )

Draw a line from source vertex to current vertex. Current vertex is the vertex
of the current mouse cursor position while button 1 is pressed.

=cut

sub motion_xy {
        my $canvas = shift;
        my $x = shift;
        my $y = shift;
        my $origin_x = shift;
        my $origin_y = shift;

        # catch unset origin
        return unless $$origin_x;

        # -- delete old line
        $canvas->delete('line');
        
        # -- draw new line
        $canvas->createLine($$origin_x, $$origin_y, $x, $y, -tags => [qw/line/]);

        printf("draw line from source vertex <%s, %s> to current vertex <%s, %s>\n", 
                $$origin_x, $$origin_y, $x, $y);
} # /motion_xy




=head2 stop_drawing_xy( $canvas, $x, $y, \$origin_x, \$origin_y )

=cut

sub stop_drawing_xy {
        my $canvas = shift;
        my $x = shift;
        my $y = shift;
        my $origin_x = shift;
        my $origin_y = shift;
        
        $$origin_x = $x;
        $$origin_y = $y;
        
        $canvas->delete('line');
        
        # -- Check if there is a valid target widget at <$x, $y>. If not, delete
        # the line && do nothing.
        my $w = $canvas->find("overlapping", $x, $y, $x+1, $y+1);
        print (defined $w ? "defined\n" : "undef\n");
        return undef unless defined $w;
        #print Dumper($w);
        
        my $id = undef;
        WIDGETS: foreach my $widget ( @{$w} ) {

                my @tags = $canvas->itemcget($widget, '-tags');
                next unless @tags;
                
                foreach my $tag ( @tags ) {
                        if( $tag =~ m/^id\d+$/ ) {
                                $id = $tag;
                                last WIDGETS;
                        }
                }
        }
        
        return undef unless $id; # there was no valid widget :-(
        
        print "target widget id = $id\n";
        
        
        
        printf("stop drawing from vertex <%s, %s> to vertex <%s, %s>\n", 
                $$origin_x, $$origin_y, $x, $y, );
} # /stop_drawing_xy

http://www.intergastro-service.de (mein erstes CMS :) )

topeg

2010-09-06 21:06

User since
2006-07-10
2611 Artikel
BenutzerIn

user image

Aus meinem Programm von mir heraus geschnitten. Der Code ist etwas älter. Ich würde es heute etwas anders strukturieren.

Code (perl): (dl )

#!/usr/bin/perl

use strict;
use warnings;
use Gtk2 '-init';
use Gnome2::Canvas;
use Data::Dumper;


my ($win,$canvas)=create_window();

create_box($canvas,{
  x=>10,
  y=>10,
  text=>'verschieben mit der mittleren Maustaste',
  on_event=>\&box_event
});
create_box($canvas,{
  x=>10,
  y=>100,
  text=>'Mit der linken Maustase erzeugt man Verbindungen',
  on_event=>\&box_event
});
create_box($canvas,{
  x=>300,
  y=>300,
  text=>'Nur ein TestText',
  on_event=>\&box_event
});
create_box($canvas,{
  x=>300,
  y=>200,
  text=>'Noch etwas mehr Text',
  on_event=>\&box_event
});

$win->show_all();

Gtk2->main();

########################################################################
sub create_window
{
 my $w_top = Gtk2::Window->new;
 $w_top->signal_connect(destroy => \&quit);

 my $vbox = Gtk2::VBox->new(0,0);
 $w_top->add($vbox);

 my $w_canvas = Gnome2::Canvas->new_aa();
 $vbox->pack_start($w_canvas, 1,1,0);
 $w_canvas->set_size_request(600,600);
 $w_canvas->set_scroll_region (0, 0, 600, 600);

 my $quit = Gtk2::Button->new("Quit");
 $quit->signal_connect(clicked => \&quit);
 $vbox->pack_start($quit, 0, 0, 0);

 return $w_top,$w_canvas;
}

sub create_box
{
  my $canvas=shift;
  my $opts=shift;
  return undef unless(ref($opts) eq 'HASH');

  $opts->{x}=0 unless($opts->{x});
  $opts->{y}=0 unless($opts->{y});
  $opts->{on_event}=sub{1} unless($opts->{on_event});

  $opts->{box_fill}='white' unless($opts->{fill});
  $opts->{box_outline}='black' unless($opts->{line});

  $opts->{text}='???' unless($opts->{text});
  $opts->{text_color}='black' unless($opts->{text_color});
  $opts->{text_font}='Sans 12' unless($opts->{text_font});
  $opts->{text_anchor}='GTK_ANCHOR_NW' unless($opts->{text_anchor});

  my $root = $canvas->root;
  my $text = Gnome2::Canvas::Item->new(
                                      $root, 'Gnome2::Canvas::Text',
                                      x => $opts->{x}+2,
                                      y => $opts->{y}+2,
                                      fill_color => $opts->{text_color},
                                      font => $opts->{text_font},
                                      anchor => 'GTK_ANCHOR_NW',
                                      text => $opts->{text} );

  my (undef,undef,$px,$py)=$text->get_bounds();

  my $box = Gnome2::Canvas::Item->new(
                                      $root, 'Gnome2::Canvas::Rect',
                                      x1 => $opts->{x},
                                      y1 => $opts->{y},
                                      x2 => $px+4,
                                      y2 => $py+4,
                                      fill_color=> $opts->{box_fill},
                                      outline_color => $opts->{box_outline});

  $box->{TEXT_ELEMENT}=$text;
  $box->go_to_top();

  my $id=$canvas->add_item($box);
  $text->set_item_id($id);
  my $cmd_ext=$opts->{on_event};

  my $cmd=sub{
    my $box=shift;

    # rise to top
    $box->go_to_top() if($_[0]->type eq 'button-press');

    # runn event
    my $bb=$box->canvas()->get_item($box->get_item_id);
    $cmd_ext->($bb,@_);
  };

  $box->signal_connect("event", $cmd);
  $text->signal_connect("event", $cmd);

  return $box;
}

sub create_line
{
  my $start_box=shift;
  my $end_box=shift;
  my $size=shift || 4;
  my $color=shift || 'green';

  # only one line!
  if( defined($start_box->{LINE_START_ID}) || defined($end_box->{LINE_END_ID}) )
  { return undef; }

  # diffent boxes
  return undef if( $start_box eq $end_box );


  my($pa_x1,$pa_y1,$pa_x2,$pa_y2)=$start_box->get_bounds();
  my($pb_x1,$pb_y1,$pb_x2,$pb_y2)=$end_box->get_bounds();

  my $line = Gnome2::Canvas::Item->new(
                                        $start_box->canvas->root, "Gnome2::Canvas::Line",
                                        points       => [
                                                          $pa_x1+int(($pa_x2-$pa_x1)/2),
                                                          $pa_y1+int(($pa_y2-$pa_y1)/2),
                                                          $pb_x1+int(($pb_x2-$pb_x1)/2),
                                                          $pb_y1+int(($pb_y2-$pb_y1)/2)],
                                        width_pixels => $size,
                                        fill_color   => $color);


  my $id=$start_box->canvas()->add_item($line);
  $start_box->{LINE_START_ID}=$id;
  $end_box->{LINE_END_ID}=$id;
  $line->{BOX_START_ID}=$start_box->get_item_id();
  $line->{BOX_END_ID}=$end_box->get_item_id();

  $start_box->go_to_top();
  $end_box->go_to_top();

  return $line;
}

sub quit{ exit; }

#-----------------------------------------------------------------------

# moving boxes (middle Mouse)
# create Line (left mouse)
{
  my $moving;
  my $line;
  sub box_event
  {
    my $box=shift;
    my $event=shift;

    # move Box
    if($event->type eq 'button-press' && $event->button() == 2)
    { $moving=[$event->x(),$event->y()]; }
    elsif($event->type eq 'button-release' && $moving)
    { $moving=undef; }
    elsif($event->type eq 'motion-notify' && $moving)
    {
      my $dx=$event->x()-$moving->[0];
      my $dy=$event->y()-$moving->[1];
      $moving=[$event->x(),$event->y()];
      $box->move($dx, $dy);
      $box->{TEXT_ELEMENT}->move($dx, $dy);
      update_line($box);
    }

    # connect_boxes
    elsif($event->type eq 'button-press' && $event->button() == 1)
    {
      my($px1,$py1,$px2,$py2)=$box->get_bounds();
      $line = Gnome2::Canvas::Item->new(
                                        $box->canvas->root, "Gnome2::Canvas::Line",
                                        points       => [
                                                          $px1+int(($px2-$px1)/2),
                                                          $py1+int(($py2-$py1)/2),
                                                          $event->x(),
                                                          $event->y(),
                                                        ],
                                        width_pixels => 4,
                                        fill_color   => 'red');
      $box->go_to_top();
    }
    elsif($event->type eq 'motion-notify' && $line)
    {
      my $p=$line->get('points');
      $p->[-2]=$event->x();
      $p->[-1]=$event->y();
      $line->set('points',$p);
    }
    elsif($event->type eq 'button-release' && $line)
    {
      $line->destroy();
      $line=undef;

      my $item=$box->canvas->get_item_at($event->x(), $event->y());

      create_line($box,$box->canvas->get_item($item->get_item_id)) if($item && defined($item->get_item_id));

    }
  }
}

sub update_line
{
  my $box=shift;
  if(defined($box->{LINE_START_ID}))
  {
    my($px1,$py1,$px2,$py2)=$box->get_bounds();

    my $line=$box->canvas->get_item($box->{LINE_START_ID});

    if($line->isa('Gnome2::Canvas::Line'))
    {
      my $p=$line->get('points');
      $p->[0]=$px1+int(($px2-$px1)/2);
      $p->[1]=$py1+int(($py2-$py1)/2);
      $line->set('points',$p);
    }
  }

  if(defined($box->{LINE_END_ID}))
  {
    my($px1,$py1,$px2,$py2)=$box->get_bounds();

    my $line=$box->canvas->get_item($box->{LINE_END_ID});

    if($line->isa('Gnome2::Canvas::Line'))
    {
      my $p=$line->get('points');
      $p->[-2]=$px1+int(($px2-$px1)/2);
      $p->[-1]=$py1+int(($py2-$py1)/2);
      $line->set('points',$p);
    }
  }
}

#=======================================================================
# Canvas
#=======================================================================

sub Gnome2::Canvas::get_item
{
  my $canvas=shift;
  my $id=shift;
  return undef unless(defined($id) && $canvas->{ELMENT_LIST});
  return $canvas->{ELMENT_LIST}->[$id];
}

sub Gnome2::Canvas::add_item
{
  my $canvas=shift;
  my $item=shift;
  $canvas->{ELMENT_LIST}=[] unless($canvas->{ELMENT_LIST});
  my $id=@{$canvas->{ELMENT_LIST}};
  $item->{ELEMENT_ID}=$id;
  push(@{$canvas->{ELMENT_LIST}}, $item);
  return $id;
}

sub Gnome2::Canvas::delete_item
{
  my $canvas=shift;
  my $item=shift;
  if($canvas->{ELMENT_LIST})
  {
    if(ref($item) && $item->isa('Gnome2::Canvas::Item'))
    {
      for(0..$#{$canvas->{ELMENT_LIST}})
      {
        if($canvas->{ELMENT_LIST}->[$_] eq $item)
        {
          $canvas->delete_item($_);
          last;
        }
      }
    }
    elsif($item=~/^\d+$/)
    {
      $canvas->{ELMENT_LIST}->[$item]->destroy();
      $canvas->{ELMENT_LIST}->[$item]=undef;
    }
  }
}

#=======================================================================
# Canvas::Item
#=======================================================================

sub Gnome2::Canvas::Item::go_to_top
{
  my $item=shift;
  $item=$item->canvas->get_item($item->{ELEMENT_ID}) if(defined($item->{ELEMENT_ID}));
  $item->raise_to_top();
  $item->{TEXT_ELEMENT}->raise_to_top() if(defined($item->{TEXT_ELEMENT}));
}

sub Gnome2::Canvas::Item::get_item_id
{
  my $item=shift;
  return $item->{ELEMENT_ID};
}

sub Gnome2::Canvas::Item::set_item_id
{
  my $item=shift;
  my $id=shift;
  return unless(defined($id) && $id=~/^\d+$/);
  $item->{ELEMENT_ID}=$id;
}

View all threads created 2010-09-05 16:05.