Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

comment on
( [id://3333]=superdoc: print w/replies, xml ) Need Help??
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

In reply to Canvas scaling/flow chart tool by Anonymous Monk

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":


  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

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

www.com | www.net | www.org
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others sharing their wisdom with the Monastery: (5)
As of 2024-04-24 22:36 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found