#!/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 = )) { 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 : state name \d+,\d+, # Begin state x coordinate, y coordinate [\w\s]*, # Optional comment \w*:?\d*:?\w*, # Optional end shape : state number : 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 (, 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 : state name \d+,\d+, # Begin state x coordinate, y coordinate [\w\s]*, # Optional comment \w*:?\d*:?\w*, # Optional end shape : state number : 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*$grid_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." ".$current_font_size*$scale, -text => $begin_name, -tags => [$begin_name."text","state_text"] ); print "Inserting at location ",$begin_x," ,",$begin_y," ", $state_records{"$begin_x,$begin_y"} , "\n"; } elsif (!$connection_records{ $begin_name."to".$end_name}) { print " Existing start state ",$begin_name, " at x,y: ",$begin_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_spacing,$end_x*$grid_spacing+(2*$radius),$end_y*$grid_spacing+(2*$radius), -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*$scale, -tags => [$end_name."text","state_text"] ); print "Inserting at location ",$end_x," ,",$end_y," ", $state_records{"$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("", [\&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("", [\&move_object, Ev('x'), Ev('y'), $current_state_record]); $canvas -> Tk::bind("", [\&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_connections; $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_spacing+$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*$radius)); $canvas->coords($current_state_record->state_name."text", $new_x_location+$radius,$new_y_location+$radius+($new_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_connections; $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_spacing+$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_start_pos, " ",$current_connection_record->connection_y_start_pos, " ",$current_connection_record->connection_x_end_pos, " ",$current_connection_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_start_pos, " ",$current_connection_record->connection_y_start_pos, " ",$current_connection_record->connection_x_end_pos, " ",$current_connection_record->connection_y_end_pos," \n"; $connection_records{"$record_name"} = $current_connection_record; } $canvas->CanvasBind("", ""); &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"); }