URL https://opencores.org/ocsvn/an-fpga-implementation-of-low-latency-noc-based-mpsoc/an-fpga-implementation-of-low-latency-noc-based-mpsoc/trunk

Subversion Repositories an-fpga-implementation-of-low-latency-noc-based-mpsoc

[/] [an-fpga-implementation-of-low-latency-noc-based-mpsoc/] [trunk/] [mpsoc/] [perl_gui/] [lib/] [perl/] [widget.pl] - Blame information for rev 17

Go to most recent revision | Details | Compare with Previous | View Log


use Glib qw/TRUE FALSE/;
#use Gtk2 '-init';
use strict;
use warnings;
 
use Gtk2::Pango;
 
 
##############
# combo box
#############
sub gen_combo{
        my ($combo_list, $combo_active_pos)= @_;
        my $combo = Gtk2::ComboBox->new_text;
 
        combo_set_names($combo,$combo_list);
        $combo->set_active($combo_active_pos);
 
        #my $font = Gtk2::Pango::FontDescription->from_string('Tahoma 5');
        #$combo->modify_font($font);
 
 
        return $combo;
}
 
 
sub combo_set_names {
        my ( $combo, $list_ref ) = @_;
        my @list=@{$list_ref};
        #print "$list[0]\n";
        for my $item (@list){$combo->append_text($item);}
}
 
 
sub gen_combo_help {
        my ($help, @combo_list, $pos)= @_;
        my $box = def_hbox(FALSE, 0);
        my $combo= gen_combo(@combo_list, $pos);
        my $button=def_image_button("icons/help.png");
 
        $button->signal_connect("clicked" => sub {message_dialog($help);});
 
        $box->pack_start( $combo, FALSE, FALSE, 3);
        $box->pack_start( $button, FALSE, FALSE, 3);
        $box->show_all;
 
        return ($box,$combo);
}
 
 
sub def_h_labeled_combo{
                my ($label_name,$combo_list,$combo_active_pos)=@_;
                my $box = def_hbox(TRUE,0);
                my $label= gen_label_in_left($label_name);
                my $combo= gen_combo($combo_list, $combo_active_pos);
                $box->pack_start( $label, FALSE, FALSE, 3);
                $box->pack_start( $combo, FALSE, TRUE, 3);
                return ($box,$combo);
}
 
sub def_h_labeled_combo_scaled{
                my ($label_name,$combo_list,$combo_active_pos,$lable_w,$comb_w)=@_;
                my $table= def_table(1,3,TRUE);
                my $label= gen_label_in_left($label_name);
                my $combo= gen_combo($combo_list, $combo_active_pos);
                $table->attach_defaults ($label, 0, $lable_w, 0, 1);
                $table->attach_defaults ($combo, 1, $lable_w+$comb_w, 0, 1);
 
 
 
 
                return ($table,$combo);
}
 
 
##############
# spin button
#############
sub gen_spin{
        my ($min,$max,$step)= @_;
        my $spin = Gtk2::SpinButton->new_with_range ($min, $max, $step);
        return $spin;
}
 
 
 
sub gen_spin_help {
        my ($help, $min,$max,$step)= @_;
        my $box = def_hbox(FALSE, 0);
        my $spin= gen_spin($min,$max,$step);
        my $button=def_image_button("icons/help.png");
 
        $button->signal_connect("clicked" => sub {message_dialog($help);});
 
        $box->pack_start( $spin, FALSE, FALSE, 3);
        $box->pack_start( $button, FALSE, FALSE, 3);
        $box->show_all;
 
        return ($box,$spin);
}
 
 
#############
#  entry
#############
sub gen_entry{
        my ($initial) = @_;
        my $entry = Gtk2::Entry->new;
        if(defined $initial){ $entry->set_text($initial)};
        return $entry;
}
 
 
sub gen_entry_help{
        my ($help, $init)= @_;
        my $box = def_hbox(FALSE, 0);
        my $entry= gen_entry ($init);
        my $button=def_image_button("icons/help.png");
 
        $button->signal_connect("clicked" => sub {message_dialog($help);});
 
        $box->pack_start( $entry, FALSE, FALSE, 3);
        $box->pack_start( $button, FALSE, FALSE, 3);
        $box->show_all;
 
        return ($box,$entry);
}
 
sub def_h_labeled_entry{
        my ($label_name,$initial)=@_;
        my $box = def_hbox(TRUE,0);
        my $label= gen_label_in_left($label_name);
        my $entry =gen_entry($initial);
        $box->pack_start( $label, FALSE, FALSE, 3);
        $box->pack_start( $entry, FALSE, FALSE, 3);
        return ($box,$entry);
 
}
 
##############
# ComboBoxEntry
##############
 
sub gen_combo_entry{
        my $list_ref=shift;
        my @list=@{$list_ref};
 
        my $combo_box_entry = Gtk2::ComboBoxEntry->new_text;
        foreach my $p (@list){
                $combo_box_entry->append_text($p);
        }
        $combo_box_entry->set_active(0);
        return $combo_box_entry;
}
 
#############
#  label
############
 
sub gen_label_in_left{
        my ($data)=@_;
        my $label   = Gtk2::Label->new($data);
        $label->set_alignment( 0, 0.5 );
        #my $font = Gtk2::Pango::FontDescription->from_string('Tahoma 5');
        #$label->modify_font($font);
        return $label;
}
 
 
sub gen_label_in_center{
        my ($data)=@_;
        my $label   = Gtk2::Label->new($data);
        return $label;
}
 
sub def_label{
        my @data=@_;
        my $label   = Gtk2::Label->new(@data);
        $label->set_alignment( 0, 0.5 );
        return $label;
 
}
 
 
sub box_label{
        my( $homogeneous, $spacing, $name)=@_;
        my $box=def_hbox($homogeneous, $spacing);
        my $label= def_label($name);
        $box->pack_start( $label, FALSE, FALSE, 3);
        return $box;
}
 
 
sub def_title_box{
        my( $homogeneous, $spacing, @labels)=@_;
        my $box=def_hbox($homogeneous, $spacing);
        foreach my $label (@labels){
                my $labelbox=box_label($homogeneous, $spacing, $label);
                $box->pack_start( $labelbox, FALSE, FALSE, 3);
 
        }
        return $box;
}
 
 
sub gen_label_help {
        my ($help, $label_name)= @_;
        my $box = def_hbox(FALSE, 0);
        my $label= gen_label_in_left($label_name);
        my $button=def_image_button("icons/help.png");
 
        $button->signal_connect("clicked" => sub {message_dialog($help);});
 
        $box->pack_start( $label, FALSE, FALSE, 0);
        $box->pack_start( $button, FALSE, FALSE, 0);
        $box->set_spacing (0);
        $box->show_all;
 
        return $box;
 
 
}
 
 
 
 
##############
# button
#############
 
 
sub button_box{
# create a new button
        my @label=@_;
        my $button = Gtk2::Button->new_from_stock(@label);
        my $box=def_hbox(TRUE,5);
        $box->pack_start($button,   FALSE, FALSE,0);
 
        return ($box,$button);
 
}
 
 
sub def_image{
        my $image_file=shift;
        my $font_size=get_deafualt_font_size();
        my $size=($font_size==10)? 25:
                     ($font_size==9 )? 22:
                         ($font_size==8 )? 18:
                         ($font_size==7 )? 15:12 ;
        my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file_at_scale($image_file,$size,$size,FALSE);
 
 
        my $image = Gtk2::Image->new_from_pixbuf($pixbuf);
        return $image;
 
}
 
 
 
sub def_image_button{
        my ($image_file, $label_text)=@_;
        # create box for image and label 
        my $box = def_hbox(FALSE,0);
        my $image = def_image($image_file);
 
 
        # now on to the image stuff
        #my $image = Gtk2::Image->new_from_file($image_file);
        $box->pack_start($image, FALSE, FALSE, 0);
        $box->set_border_width(0);
        $box->set_spacing (0);
        # Create a label for the button
        if(defined $label_text ) {
                my $label = Gtk2::Label->new("  $label_text");
                $box->pack_start($label, FALSE, FALSE, 0);
        }
 
 
        my $button = Gtk2::Button->new();
        $button->add($box);
        $button->set_border_width(0);
        $button->show_all;
        return $button;
 
}
 
 
sub def_image_label{
        my ($image_file, $label_text)=@_;
        # create box for image and label 
        my $box = def_hbox(FALSE,1);
        # now on to the image stuff
        my $image = def_image($image_file);
        $box->pack_start($image, TRUE, FALSE, 0);
        # Create a label for the button
        if(defined $label_text ) {
                my $label = Gtk2::Label->new($label_text);
                $box->pack_start($label, TRUE, FALSE, 0);
        }
 
        return $box;
 
}
 
 
sub gen_button_message {
        my ($help, $image_file,$label_name)= @_;
        my $box = def_hbox(FALSE, 0);
        my $label= gen_label_in_center($label_name) if(defined $label_name);
        my $button=def_image_button($image_file);
 
        if(defined $help ){$button->signal_connect("clicked" => sub {message_dialog($help);});}
 
        $box->pack_start( $label, FALSE, FALSE, 0) if(defined $label_name);
        $box->pack_start( $button, FALSE, FALSE, 0);
        $box->set_border_width(0);
        $box->set_spacing (0);
        $box->show_all;
 
        return $box;
 
 
}
 
 
sub def_colored_button{
        my ($label_text,$color_num)=@_;
        # create box for image and label 
        my $box = def_hbox(FALSE,0);
        my $font_size=get_deafualt_font_size();
        my $size=($font_size==10)? 25:
                     ($font_size==9 )? 22:
                         ($font_size==8 )? 18:
                         ($font_size==7 )? 15:12 ;
        $box->set_border_width(0);
        $box->set_spacing (0);
        # Create a label for the button
        if(defined $label_text ) {
                my $label = gen_label_in_center("$label_text");
                $box->pack_start($label, TRUE, TRUE, 0);
        }
        my @clr_code=get_color($color_num);
        my $color = Gtk2::Gdk::Color->new (@clr_code);
 
        my $button = Gtk2::Button->new();
        $button->modify_bg('normal',$color);
        $button->add($box);
        $button->set_border_width(0);
        $button->show_all;
        return $button;
 
}
 
 
 
 
 
 
 
############
#       message_dialog
############
 
sub message_dialog {
  my @message=@_;
  my $window;
  my $dialog = Gtk2::MessageDialog->new ($window,
                                   [qw/modal destroy-with-parent/],
                                   'info',
                                   'ok',
                                    @message);
  $dialog->run;
  $dialog->destroy;
 
}
 
 
############
# window
###########
 
sub def_win {
        my @titel=shift;
        my $window = Gtk2::Window->new('toplevel');
        $window->set_title(@titel);
        $window->set_position("center");
        $window->set_default_size(100, 100);
        $window->set_border_width(20);
        $window->signal_connect (delete_event => sub { Gtk2->main_quit });
        return $window;
 
}
 
 
sub def_win_size {
        my $x=shift;
        my $y=shift;
        my @titel=shift;
        my $window = Gtk2::Window->new('toplevel');
        $window->set_title(@titel);
        $window->set_position("center");
        $window->set_default_size($x, $y);
        $window->set_border_width(20);
        $window->signal_connect (delete_event => sub { Gtk2->main_quit });
        return $window;
 
}
 
 
sub def_popwin_size {
        my $x=shift;
        my $y=shift;
        my @titel=shift;
        #my $window = Gtk2::Window->new('popup');
        my $window = Gtk2::Window->new('toplevel');
        $window->set_title(@titel);
        $window->set_position("center");
        $window->set_default_size($x, $y);
        $window->set_border_width(20);
        $window->signal_connect (delete_event => sub { $window->destroy });
        return $window;
 
}
 
 
sub def_scrolled_window_box{
 
        my $window =  def_popwin_size(@_);
        my $box=def_vbox(TRUE,5);
        my $scrolled_window = new Gtk2::ScrolledWindow (undef, undef);
        $scrolled_window->set_policy( "automatic", "automatic" );
        $scrolled_window->add_with_viewport($box);
 
 
 
        $window->add($scrolled_window);
        $window->show_all;
        $box->show_all;
 
        return ($box,$window);
 
}
 
sub max_win_size{
        my $screen =Gtk2::Gdk::Screen->get_default();
        my $hight = $screen->get_height();
        my $width = $screen->get_width();
        return ($width,$hight);
}
 
 
sub get_deafualt_font_size{
        my($width,$hight)=max_win_size();
        #print "($width,$hight)\n";
        my $font_size=($width>=1600)? 10:
                              ($width>=1400)? 9:
                                  ($width>=1200)? 8:
                                  ($width>=1000)? 7:6;
        return $font_size;
}
 
 
sub set_deafualt_font_size{
        my $font_size=get_deafualt_font_size();
        if($font_size==10){
                Gtk2::Rc->parse_string(<<__);
                        style "normal" {
                                font_name ="Verdana 10"
                        }
                        widget "*" style "normal"
__
 
        }
        elsif ($font_size==9){
                $font_size=9;
                Gtk2::Rc->parse_string(<<__);
                style "normal" {
                                font_name ="Verdana 9"
                        }
                        widget "*" style "normal"
__
 
        }
        elsif ($font_size==8){
                $font_size=8;
                Gtk2::Rc->parse_string(<<__);
                style "normal" {
                                font_name ="Verdana 8"
                        }
                        widget "*" style "normal"
__
 
        }
        elsif ($font_size==7){
            $font_size=7;
                Gtk2::Rc->parse_string(<<__);
                style "normal" {
                                font_name ="Verdana 7"
                        }
                        widget "*" style "normal"
__
 
        }
        else{
                Gtk2::Rc->parse_string(<<__);
                style "normal" {
                                font_name ="Verdana 6"
                        }
                        widget "*" style "normal"
__
 
        }
 
 
 
}
 
 
##############
#       box
#############
 
sub def_hbox {
        my( $homogeneous, $spacing)=@_;
        my $box = Gtk2::HBox->new($homogeneous, $spacing);
        $box->set_border_width(2);
        return $box;
}
 
sub def_vbox {
        my $box = Gtk2::VBox->new(FALSE, 0);
        $box->set_border_width(2);
        return $box;
}
 
sub def_pack_hbox{
        my( $homogeneous, $spacing , @box_list)=@_;
        my $box=def_hbox($homogeneous, $spacing);
        foreach my $subbox (@box_list){
                $box->pack_start( $subbox, FALSE, FALSE, 3);
        }
        return $box;
 
 
}
 
 
 
#############
# text_view 
############
 
sub create_text {
  my $scrolled_window = Gtk2::ScrolledWindow->new;
  $scrolled_window->set_policy ('automatic', 'automatic');
  $scrolled_window->set_shadow_type ('in');
  my $tview = Gtk2::TextView->new();
  $scrolled_window->add ($tview);
  $tview->show_all;
  # Make it a bit nicer for text.
  $tview->set_wrap_mode ('word');
  $tview->set_pixels_above_lines (2);
  $tview->set_pixels_below_lines (2);
  return ($scrolled_window,$tview);
}
 
 
#################
#       table
################
 
sub def_table{
        my ($row,$col,$homogeneous)=@_;
        my $table = Gtk2::Table->new ($row, $col, $homogeneous);
        $table->set_row_spacings (0);
        $table->set_col_spacings (0);
        return $table;
 
}
 
 
 
 
 
 
######
#  state
#####
 
sub def_state{
        my ($initial)=@_;
        my $entry = Gtk2::Entry->new;
        $entry->set_text($initial);
        my $timeout=0;
        my @state= ($entry,$timeout);
        return \@state
 
}
 
sub set_state{
        my ($state,$initial,$timeout)=@_;
        my ($entry,$time_out)=@{$state};
        $entry->set_text($initial);
        @{$state}[1]=$timeout;
 
}
 
 
sub get_state{
        my ($state)=@_;
        my ($entry,$time_out)=@{$state};
        my $st;
        $st=$entry->get_text();
        return ($st,$time_out);
}
 
 
 
 
##################
#       show_info
##################
sub show_info{
        my ($textview_ref,$info)=@_;
        my $buffer = $$textview_ref->get_buffer();
        $buffer->set_text($info);
}
 
 
 
####################
#       read verilog file
##################
 
 
sub read_file{
        my @files            = @_;
        my %cmd_line_defines = ();
        my $quiet            = 1;
        my @inc_dirs         = ();
        my @lib_dirs         = ();
        my @lib_exts         = ();
        my $vdb = rvp->read_verilog(\@files,[],\%cmd_line_defines,
                          $quiet,\@inc_dirs,\@lib_dirs,\@lib_exts);
 
        my @problems = $vdb->get_problems();
        if (@problems) {
            foreach my $problem ($vdb->get_problems()) {
                print STDERR "$problem.\n";
            }
            # die "Warnings parsing files!";
        }
 
        return $vdb;
}
 
 
sub get_color {
        my $num=shift;
 
        my @colors=(
        0x6495ED,#Cornflower Blue
        0xFAEBD7,#Antiquewhite
        0xC71585,#Violet Red
        0xC0C0C0, #silver
        0xADD8E6,#Lightblue     
        0x6A5ACD,#Slate Blue
        0x00CED1,#Dark Turquoise
        0x008080,#Teal
        0x2E8B57,#SeaGreen
        0xFFB6C1,#Light Pink
        0x008000,#Green
        0xFF0000,#red
        0x808080,#Gray
        0x808000,#Olive
        0xFF69B4,#Hot Pink
        0xFFD700,#Gold
        0xDAA520,#Goldenrod
        0xFFA500,#Orange
        0x32CD32,#LimeGreen
        0x0000FF,#Blue
        0xFF8C00,#DarkOrange
        0xA0522D,#Sienna
        0xFF6347,#Tomato
        0x0000CD,#Medium Blue
        0xFF4500,#OrangeRed
        0xDC143C,#Crimson       
        0x9932CC,#Dark Orchid
        0x800000,#marron
        0x800080,#Purple
        0x4B0082,#Indigo
        0xFFFFFF #white                 
                );
 
        my $color=      ($num< scalar (@colors))? $colors[$num]: 0xFFFFFF;
        my $red=        ($color & 0xFF0000) >> 8;
        my $green=      ($color & 0x00FF00);
        my $blue=       ($color & 0x0000FF) << 8;
 
        return ($red,$green,$blue);
 
}
 
 
 
 
##############
#  clone_obj
#############
 
sub clone_obj{
        my ($self,$clone)=@_;
 
        foreach my $p (keys %$self){
                delete ($self->{$p});
        }
        foreach my $p (keys %$clone){
                $self->{$p}= $clone->{$p};
                my $ref= ref ($clone->{$p});
                if( $ref eq 'HASH' ){
 
                        foreach my $q (keys %{$clone->{$p}}){
                                $self->{$p}{$q}= $clone->{$p}{$q};
                                my $ref= ref ($self->{$p}{$q});
                                if( $ref eq 'HASH' ){
 
                                        foreach my $z (keys %{$clone->{$p}{$q}}){
                                                $self->{$p}{$q}{$z}= $clone->{$p}{$q}{$z};
                                                my $ref= ref ($self->{$p}{$q}{$z});
                                                if( $ref eq 'HASH' ){
 
                                                        foreach my $w (keys %{$clone->{$p}{$q}{$q}}){
                                                                $self->{$p}{$q}{$z}{$w}= $clone->{$p}{$q}{$z}{$w};
                                                                my $ref= ref ($self->{$p}{$q}{$z}{$w});
                                                                if( $ref eq 'HASH' ){
 
 
                                                                        foreach my $m (keys %{$clone->{$p}{$q}{$q}{$w}}){
                                                                                $self->{$p}{$q}{$z}{$w}{$m}= $clone->{$p}{$q}{$z}{$w}{$m};
                                                                                my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m});
                                                                                if( $ref eq 'HASH' ){
 
                                                                                        foreach my $n (keys %{$clone->{$p}{$q}{$q}{$w}{$m}}){
                                                                                                $self->{$p}{$q}{$z}{$w}{$m}{$n}= $clone->{$p}{$q}{$z}{$w}{$m}{$n};
                                                                                                my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m}{$n});
                                                                                                if( $ref eq 'HASH' ){
 
                                                                                                        foreach my $l (keys %{$clone->{$p}{$q}{$q}{$w}{$m}{$n}}){
                                                                                                                $self->{$p}{$q}{$z}{$w}{$m}{$n}{$l}= $clone->{$p}{$q}{$z}{$w}{$m}{$n}{$l};
                                                                                                                my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m}{$n}{$l});
                                                                                                                if( $ref eq 'HASH' ){
                                                                                                                }
                                                                                                        }
 
                                                                                                }#if                                                                                                            
                                                                                        }#n
                                                                                }#if
                                                                        }#m                                                     
                                                                }#if
                                                        }#w
                                                }#if
                                        }#z
                                }#if
                        }#q
                }#if    
        }#p
}#sub   
 
 
################
#       general
#################
 
 
 
 
sub  trim { my $s = shift;  $s=~s/[\n]//gs; return $s };
 
sub remove_all_white_spaces($)
{
  my $string = shift;
  $string =~ s/\s+//g;
  return $string;
}
 
 
 
 
sub get_scolar_pos{
        my ($item,@list)=@_;
        my $pos;
        my $i=0;
        foreach my $c (@list)
        {
                if(  $c eq $item) {$pos=$i}
                $i++;
        }
        return $pos;
}
 
sub remove_scolar_from_array{
        my ($array_ref,$item)=@_;
        my @array=@{$array_ref};
        my @new;
        foreach my $p (@array){
                if($p ne $item ){
                        push(@new,$p);
                }
        }
        return @new;
}
 
sub replace_in_array{
        my ($array_ref,$item1,$item2)=@_;
        my @array=@{$array_ref};
        my @new;
        foreach my $p (@array){
                if($p eq $item1 ){
                        push(@new,$item2);
                }else{
                        push(@new,$p);
                }
        }
        return @new;
}
 
 
 
# return an array of common elemnts between two input arays 
sub get_common_array{
        my ($a_ref,$b_ref)=@_;
        my @A=@{$a_ref};
        my @B=@{$b_ref};
        my @C;
        foreach my $p (@A){
                if( grep (/^$p$/,@B)){push(@C,$p)};
        }
        return  @C;
}
 
#a-b
sub get_diff_array{
        my ($a_ref,$b_ref)=@_;
        my @A=@{$a_ref};
        my @B=@{$b_ref};
        my @C;
        foreach my $p (@A){
                if( !grep (/^$p$/,@B)){push(@C,$p)};
        }
        return  @C;
 
}
 
 
 
sub compress_nums{
        my      @nums=@_;
        my @f=sort { $a <=> $b } @nums;
        my $s;
        my $ls;
        my $range=0;
        my $x;
 
 
        foreach my $p (@f){
                if(!defined $x) {
                        $s="$p";
                        $ls=$p;
 
                }
                else{
                        if($p-$x>1){ #gap exist
                                if( $range){
                                        $s=($x-$ls>1 )? "$s:$x,$p": "$s,$x,$p";
                                        $ls=$p;
                                        $range=0;
                                }else{
                                $s= "$s,$p";
                                $ls=$p;
 
                                }
 
                        }else {$range=1;}
 
 
 
                }
 
                $x=$p
        }
        if($range==1){ $s= ($x-$ls>1 )? "$s:$x":  "$s,$x";}
        #update $s($ls,$hs);
 
        return $s;
 
}
 
 
1

Browse

Tools

Subversion Repositories an-fpga-implementation-of-low-latency-noc-based-mpsoc

[/] [an-fpga-implementation-of-low-latency-noc-based-mpsoc/] [trunk/] [mpsoc/] [perl_gui/] [lib/] [perl/] [widget.pl] - Blame information for rev 17

Line No.	Rev	Author	Line
1	16	alirezamon	`use Glib qw/TRUE FALSE/;`
2			`#use Gtk2 '-init';`
3			`use strict;`
4			`use warnings;`
5
6			`use Gtk2::Pango;`
7
8
9			`##############`
10			`# combo box`
11			`#############`
12			`sub gen_combo{`
13			`my ($combo_list, $combo_active_pos)= @_;`
14			`my $combo = Gtk2::ComboBox->new_text;`
15
16			`combo_set_names($combo,$combo_list);`
17			`$combo->set_active($combo_active_pos);`
18
19			`#my $font = Gtk2::Pango::FontDescription->from_string('Tahoma 5');`
20			`#$combo->modify_font($font);`
21
22
23			`return $combo;`
24			`}`
25
26
27			`sub combo_set_names {`
28			`my ( $combo, $list_ref ) = @_;`
29			`my @list=@{$list_ref};`
30			`#print "$list[0]\n";`
31			`for my $item (@list){$combo->append_text($item);}`
32			`}`
33
34
35			`sub gen_combo_help {`
36			`my ($help, @combo_list, $pos)= @_;`
37			`my $box = def_hbox(FALSE, 0);`
38			`my $combo= gen_combo(@combo_list, $pos);`
39			`my $button=def_image_button("icons/help.png");`
40
41			`$button->signal_connect("clicked" => sub {message_dialog($help);});`
42
43			`$box->pack_start( $combo, FALSE, FALSE, 3);`
44			`$box->pack_start( $button, FALSE, FALSE, 3);`
45			`$box->show_all;`
46
47			`return ($box,$combo);`
48			`}`
49
50
51			`sub def_h_labeled_combo{`
52			`my ($label_name,$combo_list,$combo_active_pos)=@_;`
53			`my $box = def_hbox(TRUE,0);`
54			`my $label= gen_label_in_left($label_name);`
55			`my $combo= gen_combo($combo_list, $combo_active_pos);`
56			`$box->pack_start( $label, FALSE, FALSE, 3);`
57			`$box->pack_start( $combo, FALSE, TRUE, 3);`
58			`return ($box,$combo);`
59			`}`
60
61			`sub def_h_labeled_combo_scaled{`
62			`my ($label_name,$combo_list,$combo_active_pos,$lable_w,$comb_w)=@_;`
63			`my $table= def_table(1,3,TRUE);`
64			`my $label= gen_label_in_left($label_name);`
65			`my $combo= gen_combo($combo_list, $combo_active_pos);`
66			`$table->attach_defaults ($label, 0, $lable_w, 0, 1);`
67			`$table->attach_defaults ($combo, 1, $lable_w+$comb_w, 0, 1);`
68
69
70
71
72			`return ($table,$combo);`
73			`}`
74
75
76			`##############`
77			`# spin button`
78			`#############`
79			`sub gen_spin{`
80			`my ($min,$max,$step)= @_;`
81			`my $spin = Gtk2::SpinButton->new_with_range ($min, $max, $step);`
82			`return $spin;`
83			`}`
84
85
86
87			`sub gen_spin_help {`
88			`my ($help, $min,$max,$step)= @_;`
89			`my $box = def_hbox(FALSE, 0);`
90			`my $spin= gen_spin($min,$max,$step);`
91			`my $button=def_image_button("icons/help.png");`
92
93			`$button->signal_connect("clicked" => sub {message_dialog($help);});`
94
95			`$box->pack_start( $spin, FALSE, FALSE, 3);`
96			`$box->pack_start( $button, FALSE, FALSE, 3);`
97			`$box->show_all;`
98
99			`return ($box,$spin);`
100			`}`
101
102
103			`#############`
104			`# entry`
105			`#############`
106			`sub gen_entry{`
107			`my ($initial) = @_;`
108			`my $entry = Gtk2::Entry->new;`
109			`if(defined $initial){ $entry->set_text($initial)};`
110			`return $entry;`
111			`}`
112
113
114			`sub gen_entry_help{`
115			`my ($help, $init)= @_;`
116			`my $box = def_hbox(FALSE, 0);`
117			`my $entry= gen_entry ($init);`
118			`my $button=def_image_button("icons/help.png");`
119
120			`$button->signal_connect("clicked" => sub {message_dialog($help);});`
121
122			`$box->pack_start( $entry, FALSE, FALSE, 3);`
123			`$box->pack_start( $button, FALSE, FALSE, 3);`
124			`$box->show_all;`
125
126			`return ($box,$entry);`
127			`}`
128
129			`sub def_h_labeled_entry{`
130			`my ($label_name,$initial)=@_;`
131			`my $box = def_hbox(TRUE,0);`
132			`my $label= gen_label_in_left($label_name);`
133			`my $entry =gen_entry($initial);`
134			`$box->pack_start( $label, FALSE, FALSE, 3);`
135			`$box->pack_start( $entry, FALSE, FALSE, 3);`
136			`return ($box,$entry);`
137
138			`}`
139
140	17	alirezamon	`##############`
141			`# ComboBoxEntry`
142			`##############`
143	16	alirezamon
144	17	alirezamon	`sub gen_combo_entry{`
145			`my $list_ref=shift;`
146			`my @list=@{$list_ref};`
147
148			`my $combo_box_entry = Gtk2::ComboBoxEntry->new_text;`
149			`foreach my $p (@list){`
150			`$combo_box_entry->append_text($p);`
151			`}`
152			`$combo_box_entry->set_active(0);`
153			`return $combo_box_entry;`
154			`}`
155
156	16	alirezamon	`#############`
157			`# label`
158			`############`
159
160			`sub gen_label_in_left{`
161			`my ($data)=@_;`
162			`my $label = Gtk2::Label->new($data);`
163			`$label->set_alignment( 0, 0.5 );`
164			`#my $font = Gtk2::Pango::FontDescription->from_string('Tahoma 5');`
165			`#$label->modify_font($font);`
166			`return $label;`
167			`}`
168
169
170			`sub gen_label_in_center{`
171			`my ($data)=@_;`
172			`my $label = Gtk2::Label->new($data);`
173			`return $label;`
174			`}`
175
176			`sub def_label{`
177			`my @data=@_;`
178			`my $label = Gtk2::Label->new(@data);`
179			`$label->set_alignment( 0, 0.5 );`
180			`return $label;`
181
182			`}`
183
184
185			`sub box_label{`
186			`my( $homogeneous, $spacing, $name)=@_;`
187			`my $box=def_hbox($homogeneous, $spacing);`
188			`my $label= def_label($name);`
189			`$box->pack_start( $label, FALSE, FALSE, 3);`
190			`return $box;`
191			`}`
192
193
194			`sub def_title_box{`
195			`my( $homogeneous, $spacing, @labels)=@_;`
196			`my $box=def_hbox($homogeneous, $spacing);`
197			`foreach my $label (@labels){`
198			`my $labelbox=box_label($homogeneous, $spacing, $label);`
199			`$box->pack_start( $labelbox, FALSE, FALSE, 3);`
200
201			`}`
202			`return $box;`
203			`}`
204
205
206			`sub gen_label_help {`
207			`my ($help, $label_name)= @_;`
208			`my $box = def_hbox(FALSE, 0);`
209			`my $label= gen_label_in_left($label_name);`
210			`my $button=def_image_button("icons/help.png");`
211
212			`$button->signal_connect("clicked" => sub {message_dialog($help);});`
213
214			`$box->pack_start( $label, FALSE, FALSE, 0);`
215			`$box->pack_start( $button, FALSE, FALSE, 0);`
216			`$box->set_spacing (0);`
217			`$box->show_all;`
218
219			`return $box;`
220
221
222			`}`
223
224
225
226
227			`##############`
228			`# button`
229			`#############`
230
231
232			`sub button_box{`
233			`# create a new button`
234			`my @label=@_;`
235			`my $button = Gtk2::Button->new_from_stock(@label);`
236			`my $box=def_hbox(TRUE,5);`
237			`$box->pack_start($button, FALSE, FALSE,0);`
238
239			`return ($box,$button);`
240
241			`}`
242
243
244			`sub def_image{`
245			`my $image_file=shift;`
246			`my $font_size=get_deafualt_font_size();`
247			`my $size=($font_size==10)? 25:`
248			`($font_size==9 )? 22:`
249			`($font_size==8 )? 18:`
250			`($font_size==7 )? 15:12 ;`
251			`my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file_at_scale($image_file,$size,$size,FALSE);`
252
253
254			`my $image = Gtk2::Image->new_from_pixbuf($pixbuf);`
255			`return $image;`
256
257			`}`
258
259
260
261			`sub def_image_button{`
262			`my ($image_file, $label_text)=@_;`
263			`# create box for image and label`
264			`my $box = def_hbox(FALSE,0);`
265			`my $image = def_image($image_file);`
266
267
268			`# now on to the image stuff`
269			`#my $image = Gtk2::Image->new_from_file($image_file);`
270			`$box->pack_start($image, FALSE, FALSE, 0);`
271			`$box->set_border_width(0);`
272			`$box->set_spacing (0);`
273			`# Create a label for the button`
274			`if(defined $label_text ) {`
275			`my $label = Gtk2::Label->new(" $label_text");`
276			`$box->pack_start($label, FALSE, FALSE, 0);`
277			`}`
278
279
280			`my $button = Gtk2::Button->new();`
281			`$button->add($box);`
282			`$button->set_border_width(0);`
283			`$button->show_all;`
284			`return $button;`
285
286			`}`
287
288
289			`sub def_image_label{`
290			`my ($image_file, $label_text)=@_;`
291			`# create box for image and label`
292			`my $box = def_hbox(FALSE,1);`
293			`# now on to the image stuff`
294			`my $image = def_image($image_file);`
295			`$box->pack_start($image, TRUE, FALSE, 0);`
296			`# Create a label for the button`
297			`if(defined $label_text ) {`
298			`my $label = Gtk2::Label->new($label_text);`
299			`$box->pack_start($label, TRUE, FALSE, 0);`
300			`}`
301
302			`return $box;`
303
304			`}`
305
306
307			`sub gen_button_message {`
308			`my ($help, $image_file,$label_name)= @_;`
309			`my $box = def_hbox(FALSE, 0);`
310			`my $label= gen_label_in_center($label_name) if(defined $label_name);`
311			`my $button=def_image_button($image_file);`
312
313			`if(defined $help ){$button->signal_connect("clicked" => sub {message_dialog($help);});}`
314
315			`$box->pack_start( $label, FALSE, FALSE, 0) if(defined $label_name);`
316			`$box->pack_start( $button, FALSE, FALSE, 0);`
317			`$box->set_border_width(0);`
318			`$box->set_spacing (0);`
319			`$box->show_all;`
320
321			`return $box;`
322
323
324			`}`
325
326
327			`sub def_colored_button{`
328			`my ($label_text,$color_num)=@_;`
329			`# create box for image and label`
330			`my $box = def_hbox(FALSE,0);`
331			`my $font_size=get_deafualt_font_size();`
332			`my $size=($font_size==10)? 25:`
333			`($font_size==9 )? 22:`
334			`($font_size==8 )? 18:`
335			`($font_size==7 )? 15:12 ;`
336			`$box->set_border_width(0);`
337			`$box->set_spacing (0);`
338			`# Create a label for the button`
339			`if(defined $label_text ) {`
340			`my $label = gen_label_in_center("$label_text");`
341			`$box->pack_start($label, TRUE, TRUE, 0);`
342			`}`
343			`my @clr_code=get_color($color_num);`
344			`my $color = Gtk2::Gdk::Color->new (@clr_code);`
345
346			`my $button = Gtk2::Button->new();`
347			`$button->modify_bg('normal',$color);`
348			`$button->add($box);`
349			`$button->set_border_width(0);`
350			`$button->show_all;`
351			`return $button;`
352
353			`}`
354
355
356
357
358
359
360
361			`############`
362			`# message_dialog`
363			`############`
364
365			`sub message_dialog {`
366			`my @message=@_;`
367			`my $window;`
368			`my $dialog = Gtk2::MessageDialog->new ($window,`
369			`[qw/modal destroy-with-parent/],`
370			`'info',`
371			`'ok',`
372			`@message);`
373			`$dialog->run;`
374			`$dialog->destroy;`
375
376			`}`
377
378
379			`############`
380			`# window`
381			`###########`
382
383			`sub def_win {`
384			`my @titel=shift;`
385			`my $window = Gtk2::Window->new('toplevel');`
386			`$window->set_title(@titel);`
387			`$window->set_position("center");`
388			`$window->set_default_size(100, 100);`
389			`$window->set_border_width(20);`
390			`$window->signal_connect (delete_event => sub { Gtk2->main_quit });`
391			`return $window;`
392
393			`}`
394
395
396			`sub def_win_size {`
397			`my $x=shift;`
398			`my $y=shift;`
399			`my @titel=shift;`
400			`my $window = Gtk2::Window->new('toplevel');`
401			`$window->set_title(@titel);`
402			`$window->set_position("center");`
403			`$window->set_default_size($x, $y);`
404			`$window->set_border_width(20);`
405			`$window->signal_connect (delete_event => sub { Gtk2->main_quit });`
406			`return $window;`
407
408			`}`
409
410
411			`sub def_popwin_size {`
412			`my $x=shift;`
413			`my $y=shift;`
414			`my @titel=shift;`
415			`#my $window = Gtk2::Window->new('popup');`
416			`my $window = Gtk2::Window->new('toplevel');`
417			`$window->set_title(@titel);`
418			`$window->set_position("center");`
419			`$window->set_default_size($x, $y);`
420			`$window->set_border_width(20);`
421			`$window->signal_connect (delete_event => sub { $window->destroy });`
422			`return $window;`
423
424			`}`
425
426
427			`sub def_scrolled_window_box{`
428
429			`my $window = def_popwin_size(@_);`
430			`my $box=def_vbox(TRUE,5);`
431			`my $scrolled_window = new Gtk2::ScrolledWindow (undef, undef);`
432			`$scrolled_window->set_policy( "automatic", "automatic" );`
433			`$scrolled_window->add_with_viewport($box);`
434
435
436
437			`$window->add($scrolled_window);`
438			`$window->show_all;`
439			`$box->show_all;`
440
441			`return ($box,$window);`
442
443			`}`
444
445			`sub max_win_size{`
446			`my $screen =Gtk2::Gdk::Screen->get_default();`
447			`my $hight = $screen->get_height();`
448			`my $width = $screen->get_width();`
449			`return ($width,$hight);`
450			`}`
451
452
453			`sub get_deafualt_font_size{`
454			`my($width,$hight)=max_win_size();`
455			`#print "($width,$hight)\n";`
456			`my $font_size=($width>=1600)? 10:`
457			`($width>=1400)? 9:`
458			`($width>=1200)? 8:`
459			`($width>=1000)? 7:6;`
460			`return $font_size;`
461			`}`
462
463
464			`sub set_deafualt_font_size{`
465			`my $font_size=get_deafualt_font_size();`
466			`if($font_size==10){`
467			`Gtk2::Rc->parse_string(<<__);`
468			`style "normal" {`
469			`font_name ="Verdana 10"`
470			`}`
471			`widget "*" style "normal"`
472			`__`
473
474			`}`
475			`elsif ($font_size==9){`
476			`$font_size=9;`
477			`Gtk2::Rc->parse_string(<<__);`
478			`style "normal" {`
479			`font_name ="Verdana 9"`
480			`}`
481			`widget "*" style "normal"`
482			`__`
483
484			`}`
485			`elsif ($font_size==8){`
486			`$font_size=8;`
487			`Gtk2::Rc->parse_string(<<__);`
488			`style "normal" {`
489			`font_name ="Verdana 8"`
490			`}`
491			`widget "*" style "normal"`
492			`__`
493
494			`}`
495			`elsif ($font_size==7){`
496			`$font_size=7;`
497			`Gtk2::Rc->parse_string(<<__);`
498			`style "normal" {`
499			`font_name ="Verdana 7"`
500			`}`
501			`widget "*" style "normal"`
502			`__`
503
504			`}`
505			`else{`
506			`Gtk2::Rc->parse_string(<<__);`
507			`style "normal" {`
508			`font_name ="Verdana 6"`
509			`}`
510			`widget "*" style "normal"`
511			`__`
512
513			`}`
514
515
516
517			`}`
518
519
520			`##############`
521			`# box`
522			`#############`
523
524			`sub def_hbox {`
525			`my( $homogeneous, $spacing)=@_;`
526			`my $box = Gtk2::HBox->new($homogeneous, $spacing);`
527			`$box->set_border_width(2);`
528			`return $box;`
529			`}`
530
531			`sub def_vbox {`
532			`my $box = Gtk2::VBox->new(FALSE, 0);`
533			`$box->set_border_width(2);`
534			`return $box;`
535			`}`
536
537			`sub def_pack_hbox{`
538			`my( $homogeneous, $spacing , @box_list)=@_;`
539			`my $box=def_hbox($homogeneous, $spacing);`
540			`foreach my $subbox (@box_list){`
541			`$box->pack_start( $subbox, FALSE, FALSE, 3);`
542			`}`
543			`return $box;`
544
545
546			`}`
547
548
549
550			`#############`
551			`# text_view`
552			`############`
553
554			`sub create_text {`
555			`my $scrolled_window = Gtk2::ScrolledWindow->new;`
556			`$scrolled_window->set_policy ('automatic', 'automatic');`
557			`$scrolled_window->set_shadow_type ('in');`
558			`my $tview = Gtk2::TextView->new();`
559			`$scrolled_window->add ($tview);`
560			`$tview->show_all;`
561			`# Make it a bit nicer for text.`
562			`$tview->set_wrap_mode ('word');`
563			`$tview->set_pixels_above_lines (2);`
564			`$tview->set_pixels_below_lines (2);`
565			`return ($scrolled_window,$tview);`
566			`}`
567
568
569			`#################`
570			`# table`
571			`################`
572
573			`sub def_table{`
574			`my ($row,$col,$homogeneous)=@_;`
575			`my $table = Gtk2::Table->new ($row, $col, $homogeneous);`
576			`$table->set_row_spacings (0);`
577			`$table->set_col_spacings (0);`
578			`return $table;`
579
580			`}`
581
582
583
584
585
586
587			`######`
588			`# state`
589			`#####`
590
591			`sub def_state{`
592			`my ($initial)=@_;`
593			`my $entry = Gtk2::Entry->new;`
594			`$entry->set_text($initial);`
595			`my $timeout=0;`
596			`my @state= ($entry,$timeout);`
597			`return \@state`
598
599			`}`
600
601			`sub set_state{`
602			`my ($state,$initial,$timeout)=@_;`
603			`my ($entry,$time_out)=@{$state};`
604			`$entry->set_text($initial);`
605			`@{$state}[1]=$timeout;`
606
607			`}`
608
609
610			`sub get_state{`
611			`my ($state)=@_;`
612			`my ($entry,$time_out)=@{$state};`
613			`my $st;`
614			`$st=$entry->get_text();`
615			`return ($st,$time_out);`
616			`}`
617
618
619
620
621			`##################`
622			`# show_info`
623			`##################`
624			`sub show_info{`
625			`my ($textview_ref,$info)=@_;`
626			`my $buffer = $$textview_ref->get_buffer();`
627			`$buffer->set_text($info);`
628			`}`
629
630
631
632			`####################`
633			`# read verilog file`
634			`##################`
635
636
637			`sub read_file{`
638			`my @files = @_;`
639			`my %cmd_line_defines = ();`
640			`my $quiet = 1;`
641			`my @inc_dirs = ();`
642			`my @lib_dirs = ();`
643			`my @lib_exts = ();`
644			`my $vdb = rvp->read_verilog(\@files,[],\%cmd_line_defines,`
645			`$quiet,\@inc_dirs,\@lib_dirs,\@lib_exts);`
646
647			`my @problems = $vdb->get_problems();`
648			`if (@problems) {`
649			`foreach my $problem ($vdb->get_problems()) {`
650			`print STDERR "$problem.\n";`
651			`}`
652			`# die "Warnings parsing files!";`
653			`}`
654
655			`return $vdb;`
656			`}`
657
658
659			`sub get_color {`
660			`my $num=shift;`
661
662			`my @colors=(`
663			`0x6495ED,#Cornflower Blue`
664			`0xFAEBD7,#Antiquewhite`
665			`0xC71585,#Violet Red`
666			`0xC0C0C0, #silver`
667			`0xADD8E6,#Lightblue`
668			`0x6A5ACD,#Slate Blue`
669			`0x00CED1,#Dark Turquoise`
670			`0x008080,#Teal`
671			`0x2E8B57,#SeaGreen`
672			`0xFFB6C1,#Light Pink`
673			`0x008000,#Green`
674			`0xFF0000,#red`
675			`0x808080,#Gray`
676			`0x808000,#Olive`
677			`0xFF69B4,#Hot Pink`
678			`0xFFD700,#Gold`
679			`0xDAA520,#Goldenrod`
680			`0xFFA500,#Orange`
681			`0x32CD32,#LimeGreen`
682			`0x0000FF,#Blue`
683			`0xFF8C00,#DarkOrange`
684			`0xA0522D,#Sienna`
685			`0xFF6347,#Tomato`
686			`0x0000CD,#Medium Blue`
687			`0xFF4500,#OrangeRed`
688			`0xDC143C,#Crimson`
689			`0x9932CC,#Dark Orchid`
690			`0x800000,#marron`
691			`0x800080,#Purple`
692			`0x4B0082,#Indigo`
693			`0xFFFFFF #white`
694			`);`
695
696			`my $color= ($num< scalar (@colors))? $colors[$num]: 0xFFFFFF;`
697			`my $red= ($color & 0xFF0000) >> 8;`
698			`my $green= ($color & 0x00FF00);`
699			`my $blue= ($color & 0x0000FF) << 8;`
700
701			`return ($red,$green,$blue);`
702
703			`}`
704
705
706
707
708			`##############`
709			`# clone_obj`
710			`#############`
711
712			`sub clone_obj{`
713			`my ($self,$clone)=@_;`
714
715			`foreach my $p (keys %$self){`
716			`delete ($self->{$p});`
717			`}`
718			`foreach my $p (keys %$clone){`
719			`$self->{$p}= $clone->{$p};`
720			`my $ref= ref ($clone->{$p});`
721			`if( $ref eq 'HASH' ){`
722
723			`foreach my $q (keys %{$clone->{$p}}){`
724			`$self->{$p}{$q}= $clone->{$p}{$q};`
725			`my $ref= ref ($self->{$p}{$q});`
726			`if( $ref eq 'HASH' ){`
727
728			`foreach my $z (keys %{$clone->{$p}{$q}}){`
729			`$self->{$p}{$q}{$z}= $clone->{$p}{$q}{$z};`
730			`my $ref= ref ($self->{$p}{$q}{$z});`
731			`if( $ref eq 'HASH' ){`
732
733			`foreach my $w (keys %{$clone->{$p}{$q}{$q}}){`
734			`$self->{$p}{$q}{$z}{$w}= $clone->{$p}{$q}{$z}{$w};`
735			`my $ref= ref ($self->{$p}{$q}{$z}{$w});`
736			`if( $ref eq 'HASH' ){`
737
738
739			`foreach my $m (keys %{$clone->{$p}{$q}{$q}{$w}}){`
740			`$self->{$p}{$q}{$z}{$w}{$m}= $clone->{$p}{$q}{$z}{$w}{$m};`
741			`my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m});`
742			`if( $ref eq 'HASH' ){`
743
744			`foreach my $n (keys %{$clone->{$p}{$q}{$q}{$w}{$m}}){`
745			`$self->{$p}{$q}{$z}{$w}{$m}{$n}= $clone->{$p}{$q}{$z}{$w}{$m}{$n};`
746			`my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m}{$n});`
747			`if( $ref eq 'HASH' ){`
748
749			`foreach my $l (keys %{$clone->{$p}{$q}{$q}{$w}{$m}{$n}}){`
750			`$self->{$p}{$q}{$z}{$w}{$m}{$n}{$l}= $clone->{$p}{$q}{$z}{$w}{$m}{$n}{$l};`
751			`my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m}{$n}{$l});`
752			`if( $ref eq 'HASH' ){`
753			`}`
754			`}`
755
756			`}#if`
757			`}#n`
758			`}#if`
759			`}#m`
760			`}#if`
761			`}#w`
762			`}#if`
763			`}#z`
764			`}#if`
765			`}#q`
766			`}#if`
767			`}#p`
768			`}#sub`
769
770
771			`################`
772			`# general`
773			`#################`
774
775
776
777
778			`sub trim { my $s = shift; $s=~s/[\n]//gs; return $s };`
779
780			`sub remove_all_white_spaces($)`
781			`{`
782			`my $string = shift;`
783			`$string =~ s/\s+//g;`
784			`return $string;`
785			`}`
786
787
788
789
790			`sub get_scolar_pos{`
791			`my ($item,@list)=@_;`
792			`my $pos;`
793			`my $i=0;`
794			`foreach my $c (@list)`
795			`{`
796			`if( $c eq $item) {$pos=$i}`
797			`$i++;`
798			`}`
799			`return $pos;`
800			`}`
801
802			`sub remove_scolar_from_array{`
803			`my ($array_ref,$item)=@_;`
804			`my @array=@{$array_ref};`
805			`my @new;`
806			`foreach my $p (@array){`
807			`if($p ne $item ){`
808			`push(@new,$p);`
809			`}`
810			`}`
811			`return @new;`
812			`}`
813
814			`sub replace_in_array{`
815			`my ($array_ref,$item1,$item2)=@_;`
816			`my @array=@{$array_ref};`
817			`my @new;`
818			`foreach my $p (@array){`
819			`if($p eq $item1 ){`
820			`push(@new,$item2);`
821			`}else{`
822			`push(@new,$p);`
823			`}`
824			`}`
825			`return @new;`
826			`}`
827
828
829
830			`# return an array of common elemnts between two input arays`
831			`sub get_common_array{`
832			`my ($a_ref,$b_ref)=@_;`
833			`my @A=@{$a_ref};`
834			`my @B=@{$b_ref};`
835			`my @C;`
836			`foreach my $p (@A){`
837			`if( grep (/^$p$/,@B)){push(@C,$p)};`
838			`}`
839			`return @C;`
840			`}`
841
842			`#a-b`
843			`sub get_diff_array{`
844			`my ($a_ref,$b_ref)=@_;`
845			`my @A=@{$a_ref};`
846			`my @B=@{$b_ref};`
847			`my @C;`
848			`foreach my $p (@A){`
849			`if( !grep (/^$p$/,@B)){push(@C,$p)};`
850			`}`
851			`return @C;`
852
853			`}`
854
855
856
857			`sub compress_nums{`
858			`my @nums=@_;`
859			`my @f=sort { $a <=> $b } @nums;`
860			`my $s;`
861			`my $ls;`
862			`my $range=0;`
863			`my $x;`
864
865
866			`foreach my $p (@f){`
867			`if(!defined $x) {`
868			`$s="$p";`
869			`$ls=$p;`
870
871			`}`
872			`else{`
873			`if($p-$x>1){ #gap exist`
874			`if( $range){`
875			`$s=($x-$ls>1 )? "$s:$x,$p": "$s,$x,$p";`
876			`$ls=$p;`
877			`$range=0;`
878			`}else{`
879			`$s= "$s,$p";`
880			`$ls=$p;`
881
882			`}`
883
884			`}else {$range=1;}`
885
886
887
888			`}`
889
890			`$x=$p`
891			`}`
892			`if($range==1){ $s= ($x-$ls>1 )? "$s:$x": "$s,$x";}`
893			`#update $s($ls,$hs);`
894
895			`return $s;`
896
897			`}`
898
899
900			`1`