Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Canvas scaling/flow chart tool

by Anonymous Monk
on Nov 06, 2002 at 19:34 UTC ( [id://210855]=perlquestion: print w/replies, xml ) Need Help??

Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

Hi there. I'm trying to create an interactive flow charting tool. I've
run into some snags and I just don't know how to fix them:
1. One of the things I do is a createText but when I try to perform
a $canvas->scale("all"..... everything but the text is scaled.
Is there any type of font that is scalable?
2. Also when I "zoom out" using $canvas->scale("all",0,0,$x,$y) all
the items on the canvas seem to shift off to the upper left.
What's going on here?
3. Finally has anyone seen any type of tool like this out there that
I could get some example code from?

Thanks in advance.

Below is the code I am currently using sorry it is so rough, I'm still
pretty new to PERL.


Put the following in a file called flow_data.txt
circle:1:COUNT,1,1,,circle:2:CHECK_COUNT,9,16
circle:3:RESET_COUNT,2,3,,circle:39:CHECK_COUNT,9,16

then run the code below. Set the scale value to 0.5 and press
a radio button to see the effect described in #2
 
#!/proj/tools/perl/bin/perl -w
#use strict;

use Tk;

use Class::Struct;

use POSIX;

struct( state_entity_descr => {
           state_name =>'$',
           connection_name =>'@',
           connection_direction =>'@',
});




struct( connection_entity_descr => {
           connection_x_start_pos =>'$',
           connection_y_start_pos =>'$',
           connection_x_end_pos =>'$',
           connection_y_end_pos =>'$',
});



my $mw = MainWindow -> new;
$mw ->title("State Transitions");

my $f = $mw ->Frame(-relief => 'groove',
             -bd => 2,
         -label => "Draw") -> pack(-side => 'left', fill => 'y');

#  Add menu bar to allow selecting these later.
my $draw_item = "createOval";
my $thickness = 1;
my $scale = 1;
my $radius = 80;
my $grid_spacing = 200;

my $current_font_name ="courier";
my $current_font_size = "12";

$f ->Radiobutton (-variable => \$draw_item,
          -text => "Rectangle",
          -value => "rectangle",
          -command => \&bind_start) 
    -> pack(-anchor => 'w');

$f ->Radiobutton (-variable => \$draw_item,
          -text => "Oval",
          -value => "oval",
          -command => \&bind_start) 
    -> pack(-anchor => 'w');

$f ->Label(-text => "Scale") 
    -> pack(-anchor => 'w');
$f ->Entry(-textvariable => \$scale ) 
    -> pack(-anchor => 'w');

$f ->Label(-text => "Radius") 
    -> pack(-anchor => 'w');
$f ->Entry(-textvariable => \$radius ) 
    -> pack(-anchor => 'w');

$f ->Label(-text => "Grid Spacing") 
    -> pack(-anchor => 'w');
$f ->Entry(-textvariable => \$grid_spacing ) 
    -> pack(-anchor => 'w');

$f ->Label(-text => "Width") 
    -> pack(-anchor => 'w');
$f ->Entry(-textvariable => \$thickness ) 
    -> pack(-anchor => 'w');

$f ->Label(-text => "Font") 
    -> pack(-anchor => 'w');
$f ->Entry(-textvariable => \$current_font_size ) 
    -> pack(-anchor => 'w');
 
my $c = $mw -> Scrolled("Canvas", -cursor =>"crosshair") 
    -> pack(-side => "left", 
        -fill => 'both',
        -expand =>1);


  my $canvas = $c->Subwidget("canvas");

$f ->Button(-text => "Print to file",
            -command => \&make_ps)
    -> pack(-anchor => 'sw');


#perifery start/end calc based on $draw_item
my $startx;
my $starty;
my $endx;
my $endy;

  my $orig_x_location;
  my $orig_y_location;

  my %state_records;
  my $current_state_record = new state_entity_descr;

  my $state_record;



my $help;
my $DEBUG;
my $input_file;

    $input_file = "flow_data.txt";





my %states;
my @lines;
my @groups;

my $max_cell_x = 1;
my $max_cell_y = 1;

my $connection_name;
my $connection_direction;  

# Parse input data
open (INFILE, "<$input_file") or die "Could not open $input_file. $!\n
+";

while (defined(my $cur_line = <INFILE>))
{
   chomp $cur_line;

   # Skip blank lines
   next if ($cur_line eq "");
   # Skip commented lines
   next if ($cur_line =~ m/^\s*#/);

   # Check for legal formatting of input data
   if ($cur_line !~ m/
                       ^\s*           # Allow for leading white space
                       \w+:\d+:\w+,   # Begin shape : state number : s
+tate name
                       \d+,\d+,       # Begin state x coordinate, y co
+ordinate
                       [\w\s]*,       # Optional comment
                       \w*:?\d*:?\w*, # Optional end shape : state num
+ber : state name
                       \d+,\d+        # End x coordinate, y coordinate
                       \s*            # Space
                       (,STUB)?       # Possible stub directive
                       \s*$           # Allow for trailing white space
                     /x
       &&
       $cur_line !~ m/
                       ^\s*           # Allow for leading white space
                       GROUP:         # Group tag
                       \s*            # Space
                       (\d+,\d+\s*)+  # One or more (<x>,<y> space)
                       (".+")?        # Title
                       \s*$           # Allow for trailing white space
                     /x
      )
   {
      print STDOUT "\nILLEGAL FORMAT! : $cur_line\n\n";
      next;
   }

   print STDOUT "Line is :$cur_line\n" if ($DEBUG);
# ex lines is    circle:1:COUNT,1,1,,circle:3:CHECK_COUNT,9,10
 
   if ($cur_line =~ m/
                       ^\s*           # Allow for leading white space
                       \w+:\d+:\w+,   # Begin shape : state number : s
+tate name
                       \d+,\d+,       # Begin state x coordinate, y co
+ordinate
                       [\w\s]*,       # Optional comment
                       \w*:?\d*:?\w*, # Optional end shape : state num
+ber : state name
                       \d+,\d+        # End x coordinate, y coordinate
                       \s*            # Space
                       (,STUB)?       # Possible stub directive
                       \s*$           # Allow for trailing white space
                     /x
      )
    {
      my ($begin_state, $begin_x, $begin_y,
          $comment,
          $end_state,   $end_x,   $end_y,
          $stub_dir)                        = split(',', $cur_line);
   
      print STDOUT "begin_state $begin_state\n" if ($DEBUG);
      print STDOUT "begin_x $begin_x\n"         if ($DEBUG);
      print STDOUT "begin_y $begin_y\n"         if ($DEBUG);
      print STDOUT "comment $comment\n"         if ($DEBUG);
      print STDOUT "end_state $end_state\n"     if ($DEBUG);
      print STDOUT "end_x $end_x\n"             if ($DEBUG);
      print STDOUT "end_x $end_x\n"             if ($DEBUG);
      print STDOUT "stub_dir $stub_dir\n"       if ($DEBUG);
   

# Get the actual flow names
      $begin_state =~ m/^(\w+):(\d+):(.+)$/;
      $begin_name  = $3;
      
      $end_state =~ m/^(\w+):(\d+):(.+)$/;
      $end_name  = $3;

# Store flow states in records 
      if ( $begin_name ne $end_name) {
     if (!$state_records{"$begin_x,$begin_y"}) {

         print " New start state ",$begin_name, "  at x,y: ",$begin_x,
+" , ",$begin_y," \n";
         $state_record = new state_entity_descr;
         $state_record->state_name ($begin_name);
         $state_record->connection_name(0, $begin_name."to".$end_name)
+;
         $state_record->connection_direction(0,"start");
         $state_records{"$begin_x,$begin_y"} = $state_record;
         print "    New Connection ",$begin_name."to".$end_name, " \n"
+;
#Could use group item here
             $canvas->$draw_item ($begin_x*$grid_spacing,$begin_y*$gri
+d_spacing,$begin_x*$grid_spacing+(2*$radius),$begin_y*$grid_spacing+(
+2*$radius), 
                  -width => $thickness,
                  -tags => $begin_name );

             $canvas->createText($begin_x*$grid_spacing+$radius,$begin
+_y*$grid_spacing+$radius+($begin_x%2*10)-5,                 
                                 -font => $current_font_name." ".$curr
+ent_font_size*$scale,
                  -text => $begin_name,
                  -tags => [$begin_name."text","state_text"] );


print "Inserting at location ",$begin_x," ,",$begin_y,"   ",  $state_r
+ecords{"$begin_x,$begin_y"}  , "\n";


     } elsif (!$connection_records{ $begin_name."to".$end_name}) {

         print " Existing start state ",$begin_name, "  at x,y: ",$beg
+in_x," , ",$begin_y," \n";
         $state_record = $state_records{"$begin_x,$begin_y"};
         $connection_name  = $state_record->connection_name;
         $connection_direction  = $state_record->connection_direction;
         push (@$connection_name ,$begin_name."to".$end_name);
         push (@$connection_direction , "start");
         $state_records{"$begin_x,$begin_y"} = $state_record;
         print "    Next Connection ",$begin_name."to".$end_name, " \n
+";

     }

    
     if (!$state_records{"$end_x,$end_y"}) {

         print " New end state ",$end_name, "  at x,y: ",$end_x," , ",
+$end_y," \n";
         $state_record = new state_entity_descr;
         $state_record->state_name ($end_name);
         $state_record->connection_name(0, $begin_name."to".$end_name)
+;
         $state_record->connection_direction(0,"end");
         $state_records{"$end_x,$end_y"} = $state_record;
         print "    New Connection ",$begin_name."to".$end_name, " \n"
+;
             $canvas->$draw_item ($end_x*$grid_spacing,$end_y*$grid_sp
+acing,$end_x*$grid_spacing+(2*$radius),$end_y*$grid_spacing+(2*$radiu
+s), 
                  -width => $thickness,
                  -tags => $end_name );

             $canvas->createText($end_x*$grid_spacing+$radius,$end_y*$
+grid_spacing+$radius+($end_x%2*10)-5,
                  -text => $end_name,
                 -font => $current_font_name." ".$current_font_size*$s
+cale,
                  -tags => [$end_name."text","state_text"] );

print "Inserting at location ",$end_x," ,",$end_y,"     ",  $state_rec
+ords{"$end_x,$end_y"}  , " \n";

     }  elsif (!$connection_records{ $begin_name."to".$end_name}) {
         print " Existing end state ",$end_name, "  at x,y: ",$end_x,"
+ , ",$end_y," \n";
         $state_record = $state_records{"$end_x,$end_y"};
         $connection_name = $state_record->connection_name;
         $connection_direction = $state_record->connection_direction;
         push (@$connection_name ,$begin_name."to".$end_name);
         push (@$connection_direction , "end");
         $state_records{"$end_x,$end_y"} = $state_record;
         print "    Next Connection ",$begin_name."to".$end_name, " \n
+";
     }
     
  
     if (!$connection_records{$begin_name."to".$end_name})
     {
         $connection_record = new connection_entity_descr;
         $connection_record->connection_x_start_pos($begin_x);
         $connection_record->connection_y_start_pos($begin_y);
         $connection_record->connection_x_end_pos($end_x);
         $connection_record->connection_y_end_pos($end_y);
         $connection_records{$begin_name."to".$end_name} = $connection
+_record;  

             ($startx,$endx,$starty,$endy) =  find_perifery ($begin_x*
+$grid_spacing+$radius,$begin_y*$grid_spacing+$radius ,
                                 $end_x*$grid_spacing+$radius  ,$end_y
+*$grid_spacing+$radius );

             $canvas->createLine($startx,$starty,$endx,$endy, 
                           -arrow => "last",
               -width => $thickness,
               -tags => $begin_name."to".$end_name );

     }
     }
   }     
}

close INFILE;


   $canvas->configure(-scrollregion => [$canvas -> bbox("all")]);


  &bind_start();

MainLoop;
         
sub bind_start {
# Was only intended to bind mouse button but currently also used to 
# update canvas info when radio button pressed


#    $mw->update;
# Attempt to control size of text
  $canvas ->itemconfigure("state_text", -font=>$current_font_name." ".
+$current_font_size );

  $canvas -> Tk::bind("<Button-1>", [\&check_if_obj_selected, Ev('x'),
+ Ev('y')]);

#Attempt to scale canvas
  $canvas ->scale("all",0,0,$scale,$scale);

}

sub check_if_obj_selected {   
# checks if grid location is occupied by an item ie a state

my ($canv, $x, $y) = @_;
my $x_location;
my $y_location;
my $in_state_bubble;
my $state_record = new state_entity_descr;

  $x = $canv -> canvasx($x);
  $y = $canv -> canvasy($y);

  $x_location = int ($x/$grid_spacing);
  $y_location = int ($y/$grid_spacing);


print "checking location ",$x_location," ,",$y_location,"  found   ",$
+state_records{"$x_location,$y_location"} ,"  \n";

  if ( exists ($state_records{"$x_location,$y_location"})) { 
# Mark starting location if collision later
    $orig_x_location = $x_location;
    $orig_y_location = $y_location;

    $current_state_record = $state_records{"$x_location,$y_location"};

    delete ($state_records{"$x_location,$y_location"});

    $canvas -> Tk::bind("<Motion>", [\&move_object, Ev('x'), Ev('y'), 
+$current_state_record]);
    $canvas -> Tk::bind("<Button-1>", [\&end_moving, Ev('x'), Ev('y'),
+$current_state_record]);




  } 
}

sub move_object {
# repositions flow state and all connecting lines

my ($canv, $x, $y, $current_state_record) = @_;
my $new_x_location;
my $new_y_location;
my $x_location;
my $y_location;

  $x = $canv -> canvasx($x);
  $y = $canv -> canvasy($y);


# Redraw state
  $canvas->coords($current_state_record->state_name, 
                  $x-$radius,$y-$radius, 
                  $x+$radius,$y+$radius);

  $canvas->coords($current_state_record->state_name."text",
                  $x,$y);



my $startx;
my $starty;
my $endx;
my $endy;
my $x_pos;
my $y_pos;
my $current_connection_record;
my $record_name;
my $total_connections  = $current_state_record->connection_name;
my $total_number_of_connections =  @$total_connections;

  for($connection_index = 0; $connection_index< $total_number_of_conne
+ctions; $connection_index++) {
      $record_name = @$total_connections[$connection_index];
      $current_connection_record = $connection_records{"$record_name"}
+;

    if ($current_state_record->connection_direction($connection_index)
+ eq "start") {
      $x_pos = $current_connection_record->connection_x_end_pos;
      $y_pos = $current_connection_record->connection_y_end_pos;
      # Recalc line length
      ($startx,$endx,$starty,$endy) =  find_perifery ( $x, $y,
                               $x_pos*$grid_spacing+$radius,
                               $y_pos*$grid_spacing+$radius );
    } else {
      $x_pos = $current_connection_record->connection_x_start_pos;
      $y_pos = $current_connection_record->connection_y_start_pos;
      # Recalc line length
      ($startx,$endx,$starty,$endy) =  find_perifery ($x_pos*$grid_spa
+cing+$radius,
                              $y_pos*$grid_spacing+$radius,
                              $x, $y );
    }


# Rework Connecting lines

 # Redraw connecting lines
    $canvas->coords($record_name,
                  $startx,$starty,$endx,$endy);
  }
}

sub end_moving {
#Locks final position to the grid

my ($canv, $x, $y,$current_state_record) = @_;
my $new_x_location;
my $new_y_location;
my $x_location;
my $y_location;

  $x = $canv -> canvasx($x);
  $y = $canv -> canvasy($y);

  $x_location = int ($x/$grid_spacing);
  $y_location = int ($y/$grid_spacing);

# Check if state already exists here.  Collision!!
  if (exists ($state_records{"$x_location,$y_location"}) ) {
    $x_location = $orig_x_location;
    $y_location = $orig_y_location;
  }

  $new_x_location = $x_location * $grid_spacing;
  $new_y_location = $y_location * $grid_spacing;

my $startx;
my $starty;
my $endx;
my $endy;

# Redraw state
  $canvas->coords($current_state_record->state_name, 
                  $new_x_location,$new_y_location, 
                  $new_x_location+(2*$radius),$new_y_location+(2*$radi
+us));

  $canvas->coords($current_state_record->state_name."text",
                  $new_x_location+$radius,$new_y_location+$radius+($ne
+w_x_location%2*10)-5);



# Store record at new location
  $state_records{"$x_location,$y_location"} = $current_state_record;



# Rework Connecting lines
my $x_pos;
my $y_pos;
my $current_connection_record;
my $record_name;
my $total_connections  = $current_state_record->connection_name;
my $total_number_of_connections =  @$total_connections;

print "Setting state ",$current_state_record->state_name," \n";


  for($connection_index = 0; $connection_index< $total_number_of_conne
+ctions; $connection_index++) {
    $record_name = @$total_connections[$connection_index];
    $current_connection_record = $connection_records{"$record_name"};

    if ($current_state_record->connection_direction($connection_index)
+ eq "start") {
      $x_pos = $current_connection_record->connection_x_end_pos;
      $y_pos = $current_connection_record->connection_y_end_pos;
      # Recalc line length
      ($startx,$endx,$starty,$endy) =  find_perifery ( $new_x_location
++$radius,
                               $new_y_location+$radius,
                               $x_pos*$grid_spacing+$radius,
                               $y_pos*$grid_spacing+$radius);
    } else {
      $x_pos = $current_connection_record->connection_x_start_pos;
      $y_pos = $current_connection_record->connection_y_start_pos;
      # Recalc line length
      ($startx,$endx,$starty,$endy) =  find_perifery ($x_pos*$grid_spa
+cing+$radius,
                              $y_pos*$grid_spacing+$radius,
                              $new_x_location+$radius,
                              $new_y_location+$radius);
    }

print "  Line ",$record_name," \n";
print "     Using line ", $current_connection_record->connection_x_sta
+rt_pos, " ",$current_connection_record->connection_y_start_pos, " ",$
+current_connection_record->connection_x_end_pos, " ",$current_connect
+ion_record->connection_y_end_pos," \n";


print "    Drawing line from ",$x_pos," ",$y_pos," to ",$x_location," 
+",$y_location," \n";
 # Redraw connecting lines
    $canvas->coords($record_name,
            $startx,$starty,$endx,$endy); 

 # Update record at connection end point
    if ($current_state_record->connection_direction($connection_index)
+ eq "start") {
      $current_connection_record->connection_x_start_pos($x_location);
      $current_connection_record->connection_y_start_pos($y_location);
    } else {
      $current_connection_record->connection_x_end_pos($x_location);
      $current_connection_record->connection_y_end_pos($y_location);
    }

print "    Setting line ", $current_connection_record->connection_x_st
+art_pos, " ",$current_connection_record->connection_y_start_pos, " ",
+$current_connection_record->connection_x_end_pos, " ",$current_connec
+tion_record->connection_y_end_pos," \n";

    $connection_records{"$record_name"} = $current_connection_record;
  }

  $canvas->CanvasBind("<Motion>", "");

  &bind_start();
 
}


sub find_perifery {
# used to make arrows end at the edge of the state circles
my ($orig_x, $orig_y, $new_x, $new_y) = @_;

my $theta;

  if ($new_x != $orig_x ) { 
    $theta = POSIX::atan(($orig_y-$new_y)/($orig_x-$new_x));
  } else {
    $theta = 1.5708;
  }

my $start_x;
my $end_x;
my $start_y;
my $end_y;

  if ($new_x < $orig_x)  {
    $start_x = $orig_x-($radius*POSIX::cos($theta));
    $end_x   = $new_x + ($radius*POSIX::cos($theta));
    $start_y = $orig_y-($radius*POSIX::sin($theta));
    $end_y   = $new_y + ($radius*POSIX::sin($theta));
  } else {
    $start_x = $orig_x+($radius*POSIX::cos($theta));
    $end_x   = $new_x - ($radius*POSIX::cos($theta));
    if (($new_x == $orig_x) and ($new_y < $orig_y)) {
      $start_y = $orig_y - $radius;
      $end_y   = $new_y + $radius;
    } else {
      $start_y = $orig_y + ($radius*POSIX::sin($theta));
      $end_y   = $new_y - ($radius*POSIX::sin($theta));
    }
  }

  return  $start_x, $end_x , $start_y, $end_y;
}          

sub make_ps {
# will eventually print out flow chart
    $canvas->postscript(-file => "rcds_st.ps");
}

[download]

Edited: ~Thu Nov 7 00:04:54 2002 (GMT) by footpad: Added <readmore> tag, per Consideration

Replies are listed 'Best First'.
Re: Canvas scaling/flow chart tool
by rbc (Curate) on Nov 06, 2002 at 20:37 UTC
    You might want to implement a viewport for your tool.
    I wrote a viewport package for a simple video game that
    may be of interest to you. Take a look at the Viewport.pm
    section of this node.
[reply]
      Thanks rbc. I'm still working my way through the Viewport package but I think this will
      help a lot.
[reply]

Back to Seekers of Perl Wisdom

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: perlquestion [id://210855]
Approved by rbc
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others chanting in the Monastery: (10)
As of 2024-04-23 09:02 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found