view release on metacpan or  search on metacpan

Animator.pm  view on Meta::CPAN

 $self->set( '_saved_mod_end_seq',     $self->{_mw}->{_mod_end_seq}->get() );
 $self->set( '_saved_mod_start_seq',   $self->{_mw}->{_mod_start_seq}->get() );
 
 exit(0) if -e '_exit_for_test';
}

sub set_started_state {
#
# gathers program changes and processes them 
#
 my $self = shift;

 # init status bar
 $self->set('_meta_data_start', $self->{_mw}->{_mod_start_seq}->get()); 	
 $self->set('_meta_data_start_display', sprintf( "%8d", $self->{_mw}->{_mod_start_seq}->get() ));
 $self->set('_meta_data_end', $self->{_mw}->{_mod_end_seq}->get() );
 $self->set('_meta_data_end_display', sprintf( "%8d", $self->{_mw}->{_mod_end_seq}->get() ));
 $self->set( '_status','RUNNING');
 $self->set( '_msg'   ,'Animation in Progress');

 if ($self->{_mw}->{_mod_start_seq}->get() < 1 ) {
    $self->{_mw}->messageBox(-title => "Error setting new start sequence", -type => "Ok", -message => "edit start sequence to be a integer greater then 0");
    return(0);
 }

 if ($self->{_mw}->{_mod_start_seq}->get() >=  $self->{_mw}->{_mod_end_seq}->get() ) {
    $self->{_mw}->messageBox(-title => "Error setting new start sequence", -type => "Ok", -message => "edit start sequence to be less then end sequence");
    return(0);
 }
 
 if ( $self->{_mw}->{_mod_end_seq}->get() > $self->{_meta_data_end} ) {
    $self->{_mw}->messageBox(-title => "Error setting new end sequence", -type => "Ok", -message => "edit end sequence to be less then end record of meta-data");
    return(0);
 } 

   if ( $self->{_saved_mod_start_seq} != $self->{_mw}->{_mod_start_seq}->get() ) {
       $self->set( '_index', $self->{_mw}->{_mod_start_seq}->get());
      }
      elsif ( $self->{_saved_mod_start_seq} == $self->{_mw}->{_mod_start_seq}->get() ) {
               $self->set( '_index',  $self->{_index});
            }
}

sub set_init_state {
#
# sets the defaults for the program when an initial state is requested
# and is generally called after a change to the meta data is requested
#
my $self = shift;
$self->set_stopped_state(); 
$self->set( '_direction'   ,'FWD'); 
# init status bar
$self->set('_meta_data_start', 1); 	
$self->set('_meta_data_start_display', 1);
$self->set('_meta_data_end', scalar(@{$self->{_meta_ref}}) );  
$self->set('_meta_data_end_display', sprintf( "%8d", scalar(@{$self->{_meta_ref}}) ) );
$self->set( '_index', $self->{_mw}->{_mod_start_seq}->get()); 
$self->set_started_state(); 
}

sub update_delay {
my $self = shift;
my $delay = shift;

return if ( ! defined($self->{_timer_id}));

$self->set( '_delay', $delay);
$self->set( '_delay_msg', $self->{_delay} . ' ms');

$self->{_timer_id}->cancel;
$self->{_timer_id} = $self->{_table}->repeat($self->{_delay}, sub { $self->update_table }, $self->{_table});            
}

sub format_table {    
my $self = shift;
my $table = shift;
my ($row, $col);


    $table->configure( -rows => $self->{_frame_window}, -bg => 'white' );
    $table->configure( -fixedrows => 0 );
    for $row (1..$self->{_frame_window}) {

      $self->{_label_hash_ref}->{"${row}_1"} = $table->Label(-text   => '', -width  => 6,   -relief => 'flat', -background => 'white', -anchor => 'w');
      $table->put($row,1,$self->{_label_hash_ref}->{"${row}_1"});

      $self->{_label_hash_ref}->{"${row}_2"} = $table->Label(-text   => '', -width  => 6,   -relief => 'flat', -background => 'white', -anchor => 'w');
      $table->put($row,2,$self->{_label_hash_ref}->{"${row}_2"});

      $self->{_label_hash_ref}->{"${row}_3"} = $table->Label(-text   => '', -width  => 150, -relief => 'flat', -background => 'white', -anchor => 'w');
      $table->put($row,3,$self->{_label_hash_ref}->{"${row}_3"});
      
    }
    $table->pack(-expand => 0 ,-fill => 'both');
}

sub calculate_pct {
my $self = shift;
my $start = shift;  
my $end = shift;
my $row = shift;

   my $total_executions = abs($start-$end)+1; 
   my $executions_done = abs($start-$row);   
   return(0) if ($total_executions == 0);

   my $pct = int((($executions_done/$total_executions)*100)+.1);
   return( $pct);
}

sub load_file_cache {
my $self = shift;
my %unique_files; 
my @cache = ();

      foreach my $data (@{$self->{_meta_ref}}) {
          my $file = substr $data, 6, 128;
          $file = $self->good_filename( $file );   # if a filename cannot be parsed        
          next if ! defined($file);                # or name be parsed skip it
          if (! -e $file) {
               print STDERR "file $file not found!","\n";

Animator.pm  view on Meta::CPAN

#---
#
# get executions
#
#---
my $exec_line = $table->get($line-$self->{_offset}+1, 1);
$exec_line->configure(-background => 'pink') if (defined($exec_line));
my $executions = $exec_line->cget('-text');

#---
#
# get line number for source file
#
#---

my $line_no = $table->get($line-$self->{_offset}+1, 2);
$line_no->configure(-background => 'pink') if (defined($line_no));     

my $line_number = $line_no->cget('-text');
       if ( ! defined($self->{_executions_ref}->{$self->{ '_loaded_file' } . $line_number }) ) { 
              $self->{_executions_ref}->{$self->{ '_loaded_file' } . $line_number }= 1;
          }
        else {
               $self->{_executions_ref}->{$self->{ '_loaded_file' } . $line_number }++;
             }
             
# update executions
$exec_line->configure(-text => $self->{_executions_ref}->{$self->{ '_loaded_file' } . $line_number });


my $code = $table->get($line-$self->{_offset}+1, 3);
$code->configure(-background => 'pink') if (defined($code));     

$table->see($line-$self->{_offset}+1, 1);
}

sub good_filename {
my $self = shift;
my $file = shift;

# attempts to recover distorted filenames
# should go here
#
if (($^O eq 'MSWin32') and ( $file =~ m{(\w{1}:([\\/]\w+)+(.pm|.pl)*|\w+.pl)}g )) {
    return(undef) unless defined($1);
      if ( -e $1) {
                   return($1);
                  }
}

if (($^O ne 'MSWin32') and ( $file =~ m{(([\\/]\w+)+(.pm|.pl)*|\w+.pl)}g )) {
    return(undef) unless defined($1);
      if ( -e $1) {
                   return($1);
                  }
}

return(undef)
}
       
sub update_table {
my $self = shift;
my $table = shift;  

    $self->{_mw}->update; 
    return if ($self->{_status} eq 'STOPPED');  
    return if ($self->{_status} eq 'INIT');  	
    return if (! $self->done_loading_meta_data()); 

    return unless $self->retreiving_data();
	
    $self->set( '_sequence', $self->trim( substr $self->{'_meta_ref'}[ $self->{'_index'}], 0, 6) );
    $self->set( '_file', substr $self->{'_meta_ref'}[ $self->{'_index'}], 6, 128);
    $self->set( '_line', $self->trim( substr $self->{'_meta_ref'}[ $self->{'_index'}], 134, 6) );
    $self->set( '_code', substr $self->{'_meta_ref'}[ $self->{'_index'}], 140, 80);
    $self->set( '_cur_srce_line', $self->{_line} );
    $self->set( '_cur_exec_line', $self->{_sequence} );
	
	my $dir_offset;
	if ( $self->{_direction} eq 'FWD' ) { $dir_offset = 2; }
	else                                { $dir_offset = 1; }
	
    $self->set( '_pct_complete',  $self->calculate_pct( $self->{_mw}->{_mod_start_seq}->get(), $self->{_mw}->{_mod_end_seq}->get(), $self->{'_index'}+$dir_offset) . ' %');

    $self->{_file} = $self->good_filename( $self->{_file} );
    return if ! defined($self->{_file});

    # ways for a new file to be loaded
    #  1. the display widget is currently empty and we have read the first meta record
    #  2. the current meta record has a different file then is presently loaded in the display
    #     how to load a new file
    #  1. if the file is smaller then the frame_window then the entire file is loaded
    #     into the display.
    #  2. if the file is larger then the frame_window the take the line_number 
    #     - frame_window/2 and line_number + frame_window/2 from the file and
    #     load that to the display

    if ( ! defined($self->{_loaded_file}) or ($self->{_file} ne $self->{_loaded_file} ) or ($self->{_status} eq 'INIT')) {
       $self->set( '_loaded_file', $self->{_file}); 
       my $file_splice_ref = $self->get_file_splice( $self->{_file}, $self->{_line});
       $self->set( '_file_splice_ref', $file_splice_ref );   
       $self->load_display(  $self->{_file_splice_ref}, $self->{_line}, $self->{_offset}, $self->{_table});
       $self->set( '_screen_mode', 'load'); 
	   $self->set( '_status', 'RUNNING');
    }
    # if it is not an initial file or new file, ccheck if the window parameters on
    # the file have changed ot normal SOP 
    elsif ( $self->changed_window() ) {
            $self->set( '_file_splice_ref', $self->get_file_splice( $self->{_file}, $self->{_line}) );   
            $self->load_display(  $self->{_file_splice_ref}, $self->{_line}, $self->{_offset}, $self->{_table});
            $self->set( '_screen_mode', 'update');       
          }

    $self->highlight($self->{_line}, $self->{_last_line}, $self->{_start_sequence}, $self->{_end_sequence}, $self->{_table});
    $self->set( '_last_line', $self->{_line});
    $self->set( '_screen_mode', 'static');

    if ( defined($ENV{ANI_DEBUG}) and $ENV{ANI_DEBUG} == 1 ) {  $self->dump_self(),"\n"; }
}

} # end of Devel