#!/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