use Glib qw/TRUE FALSE/;
|
use Glib qw/TRUE FALSE/;
|
#use Gtk2 '-init';
|
#use Gtk2 '-init';
|
use strict;
|
use strict;
|
use warnings;
|
use warnings;
|
|
|
|
|
|
|
|
|
use Gtk2::Pango;
|
use Gtk2::Pango;
|
#use Tk::Animation;
|
#use Tk::Animation;
|
|
|
|
use String::Similarity;
|
|
|
|
|
|
sub find_the_most_similar_position{
|
|
my ($item ,@list)=@_;
|
|
my $most_similar_pos=0;
|
|
my $lastsim=0;
|
|
my $i=0;
|
|
# convert item to lowercase
|
|
$item = lc $item;
|
|
foreach my $p(@list){
|
|
my $similarity= similarity $item, $p;
|
|
if ($similarity > $lastsim){
|
|
$lastsim=$similarity;
|
|
$most_similar_pos=$i;
|
|
}
|
|
$i++;
|
|
}
|
|
return $most_similar_pos;
|
|
}
|
|
|
##############
|
##############
|
# combo box
|
# combo box
|
#############
|
#############
|
sub gen_combo{
|
sub gen_combo{
|
my ($combo_list, $combo_active_pos)= @_;
|
my ($combo_list, $combo_active_pos)= @_;
|
my $combo = Gtk2::ComboBox->new_text;
|
my $combo = Gtk2::ComboBox->new_text;
|
|
|
combo_set_names($combo,$combo_list);
|
combo_set_names($combo,$combo_list);
|
$combo->set_active($combo_active_pos) if(defined $combo_active_pos);
|
$combo->set_active($combo_active_pos) if(defined $combo_active_pos);
|
|
|
#my $font = Gtk2::Pango::FontDescription->from_string('Tahoma 5');
|
#my $font = Gtk2::Pango::FontDescription->from_string('Tahoma 5');
|
#$combo->modify_font($font);
|
#$combo->modify_font($font);
|
|
|
|
|
return $combo;
|
return $combo;
|
}
|
}
|
|
|
|
|
sub combo_set_names {
|
sub combo_set_names {
|
my ( $combo, $list_ref ) = @_;
|
my ( $combo, $list_ref ) = @_;
|
my @list=@{$list_ref};
|
my @list=@{$list_ref};
|
#print "$list[0]\n";
|
#print "$list[0]\n";
|
for my $item (@list){$combo->append_text($item);}
|
for my $item (@list){$combo->append_text($item);}
|
}
|
}
|
|
|
|
|
sub gen_combo_help {
|
sub gen_combo_help {
|
my ($help, @combo_list, $pos)= @_;
|
my ($help, @combo_list, $pos)= @_;
|
my $box = def_hbox(FALSE, 0);
|
my $box = def_hbox(FALSE, 0);
|
my $combo= gen_combo(@combo_list, $pos);
|
my $combo= gen_combo(@combo_list, $pos);
|
my $button=def_image_button("icons/help.png");
|
my $button=def_image_button("icons/help.png");
|
|
|
$button->signal_connect("clicked" => sub {message_dialog($help);});
|
$button->signal_connect("clicked" => sub {message_dialog($help);});
|
|
|
$box->pack_start( $combo, FALSE, FALSE, 3);
|
$box->pack_start( $combo, FALSE, FALSE, 3);
|
$box->pack_start( $button, FALSE, FALSE, 3);
|
$box->pack_start( $button, FALSE, FALSE, 3);
|
$box->show_all;
|
$box->show_all;
|
|
|
return ($box,$combo);
|
return ($box,$combo);
|
}
|
}
|
|
|
|
|
sub def_h_labeled_combo{
|
sub def_h_labeled_combo{
|
my ($label_name,$combo_list,$combo_active_pos)=@_;
|
my ($label_name,$combo_list,$combo_active_pos)=@_;
|
my $box = def_hbox(TRUE,0);
|
my $box = def_hbox(TRUE,0);
|
my $label= gen_label_in_left($label_name);
|
my $label= gen_label_in_left($label_name);
|
my $combo= gen_combo($combo_list, $combo_active_pos);
|
my $combo= gen_combo($combo_list, $combo_active_pos);
|
$box->pack_start( $label, FALSE, FALSE, 3);
|
$box->pack_start( $label, FALSE, FALSE, 3);
|
$box->pack_start( $combo, FALSE, TRUE, 3);
|
$box->pack_start( $combo, FALSE, TRUE, 3);
|
return ($box,$combo);
|
return ($box,$combo);
|
}
|
}
|
|
|
sub def_h_labeled_combo_scaled{
|
sub def_h_labeled_combo_scaled{
|
my ($label_name,$combo_list,$combo_active_pos,$lable_w,$comb_w)=@_;
|
my ($label_name,$combo_list,$combo_active_pos,$lable_w,$comb_w)=@_;
|
my $table= def_table(1,3,TRUE);
|
my $table= def_table(1,3,TRUE);
|
my $label= gen_label_in_left($label_name);
|
my $label= gen_label_in_left($label_name);
|
my $combo= gen_combo($combo_list, $combo_active_pos);
|
my $combo= gen_combo($combo_list, $combo_active_pos);
|
$table->attach_defaults ($label, 0, $lable_w, 0, 1);
|
$table->attach_defaults ($label, 0, $lable_w, 0, 1);
|
$table->attach_defaults ($combo, 1, $lable_w+$comb_w, 0, 1);
|
$table->attach_defaults ($combo, 1, $lable_w+$comb_w, 0, 1);
|
|
|
|
|
|
|
|
|
return ($table,$combo);
|
return ($table,$combo);
|
}
|
}
|
|
|
|
|
##############
|
##############
|
# spin button
|
# spin button
|
#############
|
#############
|
sub gen_spin{
|
sub gen_spin{
|
my ($min,$max,$step)= @_;
|
my ($min,$max,$step)= @_;
|
my $spin = Gtk2::SpinButton->new_with_range ($min, $max, $step);
|
my $spin = Gtk2::SpinButton->new_with_range ($min, $max, $step);
|
return $spin;
|
return $spin;
|
}
|
}
|
|
|
|
|
|
|
sub gen_spin_help {
|
sub gen_spin_help {
|
my ($help, $min,$max,$step)= @_;
|
my ($help, $min,$max,$step)= @_;
|
my $box = def_hbox(FALSE, 0);
|
my $box = def_hbox(FALSE, 0);
|
my $spin= gen_spin($min,$max,$step);
|
my $spin= gen_spin($min,$max,$step);
|
my $button=def_image_button("icons/help.png");
|
my $button=def_image_button("icons/help.png");
|
|
|
$button->signal_connect("clicked" => sub {message_dialog($help);});
|
$button->signal_connect("clicked" => sub {message_dialog($help);});
|
|
|
$box->pack_start( $spin, FALSE, FALSE, 3);
|
$box->pack_start( $spin, FALSE, FALSE, 3);
|
$box->pack_start( $button, FALSE, FALSE, 3);
|
$box->pack_start( $button, FALSE, FALSE, 3);
|
$box->show_all;
|
$box->show_all;
|
|
|
return ($box,$spin);
|
return ($box,$spin);
|
}
|
}
|
|
|
|
|
#############
|
#############
|
# entry
|
# entry
|
#############
|
#############
|
sub gen_entry{
|
sub gen_entry{
|
my ($initial) = @_;
|
my ($initial) = @_;
|
my $entry = Gtk2::Entry->new;
|
my $entry = Gtk2::Entry->new;
|
if(defined $initial){ $entry->set_text($initial)};
|
if(defined $initial){ $entry->set_text($initial)};
|
return $entry;
|
return $entry;
|
}
|
}
|
|
|
|
|
sub gen_entry_help{
|
sub gen_entry_help{
|
my ($help, $init)= @_;
|
my ($help, $init)= @_;
|
my $box = def_hbox(FALSE, 0);
|
my $box = def_hbox(FALSE, 0);
|
my $entry= gen_entry ($init);
|
my $entry= gen_entry ($init);
|
my $button=def_image_button("icons/help.png");
|
my $button=def_image_button("icons/help.png");
|
|
|
$button->signal_connect("clicked" => sub {message_dialog($help);});
|
$button->signal_connect("clicked" => sub {message_dialog($help);});
|
|
|
$box->pack_start( $entry, FALSE, FALSE, 3);
|
$box->pack_start( $entry, FALSE, FALSE, 3);
|
$box->pack_start( $button, FALSE, FALSE, 3);
|
$box->pack_start( $button, FALSE, FALSE, 3);
|
$box->show_all;
|
$box->show_all;
|
|
|
return ($box,$entry);
|
return ($box,$entry);
|
}
|
}
|
|
|
sub def_h_labeled_entry{
|
sub def_h_labeled_entry{
|
my ($label_name,$initial)=@_;
|
my ($label_name,$initial)=@_;
|
my $box = def_hbox(TRUE,0);
|
my $box = def_hbox(TRUE,0);
|
my $label= gen_label_in_left($label_name);
|
my $label= gen_label_in_left($label_name);
|
my $entry =gen_entry($initial);
|
my $entry =gen_entry($initial);
|
$box->pack_start( $label, FALSE, FALSE, 3);
|
$box->pack_start( $label, FALSE, FALSE, 3);
|
$box->pack_start( $entry, FALSE, FALSE, 3);
|
$box->pack_start( $entry, FALSE, FALSE, 3);
|
return ($box,$entry);
|
return ($box,$entry);
|
|
|
}
|
}
|
|
|
sub def_h_labeled_entry_help{
|
sub def_h_labeled_entry_help{
|
my ($help,$label_name,$initial)=@_;
|
my ($help,$label_name,$initial)=@_;
|
my $box = def_hbox(TRUE,0);
|
my $box = def_hbox(TRUE,0);
|
my $label= gen_label_in_left($label_name);
|
my $label= gen_label_in_left($label_name);
|
my ($b,$entry) =gen_entry_help($help,$initial);
|
my ($b,$entry) =gen_entry_help($help,$initial);
|
$box->pack_start( $label, FALSE, FALSE, 3);
|
$box->pack_start( $label, FALSE, FALSE, 3);
|
$box->pack_start( $b, FALSE, FALSE, 3);
|
$box->pack_start( $b, FALSE, FALSE, 3);
|
return ($box,$entry);
|
return ($box,$entry);
|
|
|
}
|
}
|
|
|
##############
|
##############
|
# ComboBoxEntry
|
# ComboBoxEntry
|
##############
|
##############
|
|
|
sub gen_combo_entry{
|
sub gen_combo_entry{
|
my ($list_ref,$pos)=@_;
|
my ($list_ref,$pos)=@_;
|
my @list=@{$list_ref};
|
my @list=@{$list_ref};
|
|
|
my $combo_box_entry = Gtk2::ComboBoxEntry->new_text;
|
my $combo_box_entry = Gtk2::ComboBoxEntry->new_text;
|
foreach my $p (@list){
|
foreach my $p (@list){
|
$combo_box_entry->append_text($p);
|
$combo_box_entry->append_text($p);
|
}
|
}
|
$pos=0 if(! defined $pos );
|
$pos=0 if(! defined $pos );
|
$combo_box_entry->set_active($pos);
|
$combo_box_entry->set_active($pos);
|
return $combo_box_entry;
|
return $combo_box_entry;
|
}
|
}
|
|
|
|
|
sub def_h_labeled_combo_entry_help{
|
sub def_h_labeled_combo_entry_help{
|
my ($help,$label_name,$list_ref,$initial)=@_;
|
my ($help,$label_name,$list_ref,$initial)=@_;
|
my $box = def_hbox(TRUE,0);
|
my $box = def_hbox(TRUE,0);
|
my $label= gen_label_in_left($list_ref);
|
my $label= gen_label_in_left($list_ref);
|
my ($b,$entry) =gen_combo_entry($help,$initial);
|
my ($b,$entry) =gen_combo_entry($help,$initial);
|
$box->pack_start( $label, FALSE, FALSE, 3);
|
$box->pack_start( $label, FALSE, FALSE, 3);
|
$box->pack_start( $b, FALSE, FALSE, 3);
|
$box->pack_start( $b, FALSE, FALSE, 3);
|
return ($box,$entry);
|
return ($box,$entry);
|
|
|
}
|
}
|
|
|
###########
|
###########
|
#
|
#
|
###########
|
###########
|
|
|
sub def_h_labeled_checkbutton{
|
sub def_h_labeled_checkbutton{
|
my ($label_name,$status)=@_;
|
my ($label_name,$status)=@_;
|
my $box = def_hbox(TRUE,0);
|
my $box = def_hbox(TRUE,0);
|
my $label= gen_label_in_left($label_name);
|
my $label= gen_label_in_left($label_name);
|
my $check= Gtk2::CheckButton->new;
|
my $check= Gtk2::CheckButton->new;
|
#if($status==1) $check->
|
#if($status==1) $check->
|
$box->pack_start( $label, FALSE, FALSE, 3);
|
$box->pack_start( $label, FALSE, FALSE, 3);
|
$box->pack_start( $check, FALSE, FALSE, 3);
|
$box->pack_start( $check, FALSE, FALSE, 3);
|
return ($box,$check);
|
return ($box,$check);
|
|
|
}
|
}
|
|
|
|
|
|
|
|
|
#############
|
#############
|
# label
|
# label
|
############
|
############
|
|
|
sub gen_label_in_left{
|
sub gen_label_in_left{
|
my ($data)=@_;
|
my ($data)=@_;
|
my $label = Gtk2::Label->new($data);
|
my $label = Gtk2::Label->new($data);
|
$label->set_alignment( 0, 0.5 );
|
$label->set_alignment( 0, 0.5 );
|
#my $font = Gtk2::Pango::FontDescription->from_string('Tahoma 5');
|
#my $font = Gtk2::Pango::FontDescription->from_string('Tahoma 5');
|
#$label->modify_font($font);
|
#$label->modify_font($font);
|
return $label;
|
return $label;
|
}
|
}
|
|
|
|
|
sub gen_label_in_center{
|
sub gen_label_in_center{
|
my ($data)=@_;
|
my ($data)=@_;
|
my $label = Gtk2::Label->new($data);
|
my $label = Gtk2::Label->new($data);
|
return $label;
|
return $label;
|
}
|
}
|
|
|
sub def_label{
|
sub def_label{
|
my @data=@_;
|
my @data=@_;
|
my $label = Gtk2::Label->new(@data);
|
my $label = Gtk2::Label->new(@data);
|
$label->set_alignment( 0, 0.5 );
|
$label->set_alignment( 0, 0.5 );
|
return $label;
|
return $label;
|
|
|
}
|
}
|
|
|
|
|
sub box_label{
|
sub box_label{
|
my( $homogeneous, $spacing, $name)=@_;
|
my( $homogeneous, $spacing, $name)=@_;
|
my $box=def_hbox($homogeneous, $spacing);
|
my $box=def_hbox($homogeneous, $spacing);
|
my $label= def_label($name);
|
my $label= def_label($name);
|
$box->pack_start( $label, FALSE, FALSE, 3);
|
$box->pack_start( $label, FALSE, FALSE, 3);
|
return $box;
|
return $box;
|
}
|
}
|
|
|
|
|
sub def_title_box{
|
sub def_title_box{
|
my( $homogeneous, $spacing, @labels)=@_;
|
my( $homogeneous, $spacing, @labels)=@_;
|
my $box=def_hbox($homogeneous, $spacing);
|
my $box=def_hbox($homogeneous, $spacing);
|
foreach my $label (@labels){
|
foreach my $label (@labels){
|
my $labelbox=box_label($homogeneous, $spacing, $label);
|
my $labelbox=box_label($homogeneous, $spacing, $label);
|
$box->pack_start( $labelbox, FALSE, FALSE, 3);
|
$box->pack_start( $labelbox, FALSE, FALSE, 3);
|
|
|
}
|
}
|
return $box;
|
return $box;
|
}
|
}
|
|
|
|
|
sub gen_label_help {
|
sub gen_label_help {
|
my ($help, $label_name)= @_;
|
my ($help, $label_name)= @_;
|
my $box = def_hbox(FALSE, 0);
|
my $box = def_hbox(FALSE, 0);
|
my $label= gen_label_in_left($label_name);
|
my $label= gen_label_in_left($label_name);
|
my $button=def_image_button("icons/help.png");
|
my $button=def_image_button("icons/help.png");
|
|
|
$button->signal_connect("clicked" => sub {message_dialog($help);});
|
$button->signal_connect("clicked" => sub {message_dialog($help);});
|
|
|
$box->pack_start( $label, FALSE, FALSE, 0);
|
$box->pack_start( $label, FALSE, FALSE, 0);
|
$box->pack_start( $button, FALSE, FALSE, 0);
|
$box->pack_start( $button, FALSE, FALSE, 0);
|
$box->set_spacing (0);
|
$box->set_spacing (0);
|
$box->show_all;
|
$box->show_all;
|
|
|
return $box;
|
return $box;
|
|
|
|
|
}
|
}
|
|
|
|
|
|
|
|
|
##############
|
##############
|
# button
|
# button
|
#############
|
#############
|
|
|
|
|
sub button_box{
|
sub button_box{
|
# create a new button
|
# create a new button
|
my @label=@_;
|
my @label=@_;
|
my $button = Gtk2::Button->new_from_stock(@label);
|
my $button = Gtk2::Button->new_from_stock(@label);
|
my $box=def_hbox(TRUE,5);
|
my $box=def_hbox(TRUE,5);
|
$box->pack_start($button, FALSE, FALSE,0);
|
$box->pack_start($button, FALSE, FALSE,0);
|
|
|
return ($box,$button);
|
return ($box,$button);
|
|
|
}
|
}
|
|
|
|
|
sub def_icon{
|
sub def_icon{
|
my $image_file=shift;
|
my $image_file=shift;
|
my $font_size=get_defualt_font_size();
|
my $font_size=get_defualt_font_size();
|
my $size=($font_size==10)? 25:
|
my $size=($font_size==10)? 25:
|
($font_size==9 )? 22:
|
($font_size==9 )? 22:
|
($font_size==8 )? 18:
|
($font_size==8 )? 18:
|
($font_size==7 )? 15:12 ;
|
($font_size==7 )? 15:12 ;
|
my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file_at_scale($image_file,$size,$size,FALSE);
|
my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file_at_scale($image_file,$size,$size,FALSE);
|
|
|
|
|
my $image = Gtk2::Image->new_from_pixbuf($pixbuf);
|
my $image = Gtk2::Image->new_from_pixbuf($pixbuf);
|
return $image;
|
return $image;
|
|
|
}
|
}
|
|
|
|
|
sub open_image{
|
sub open_image{
|
my ($image_file,$x,$y,$unit)=@_;
|
my ($image_file,$x,$y,$unit)=@_;
|
if(defined $unit){
|
if(defined $unit){
|
my($width,$hight)=max_win_size();
|
my($width,$hight)=max_win_size();
|
if($unit eq 'percent'){
|
if($unit eq 'percent'){
|
$x= ($x * $width)/100;
|
$x= ($x * $width)/100;
|
$y= ($y * $hight)/100;
|
$y= ($y * $hight)/100;
|
} # else its pixels
|
} # else its pixels
|
|
|
}
|
}
|
my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file_at_scale($image_file,$x,$y,TRUE);
|
my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file_at_scale($image_file,$x,$y,TRUE);
|
my $image = Gtk2::Image->new_from_pixbuf($pixbuf);
|
my $image = Gtk2::Image->new_from_pixbuf($pixbuf);
|
return $image;
|
return $image;
|
|
|
}
|
}
|
|
|
|
|
|
|
sub def_image_button{
|
sub def_image_button{
|
my ($image_file, $label_text, $homogeneous)=@_;
|
my ($image_file, $label_text, $homogeneous)=@_;
|
# create box for image and label
|
# create box for image and label
|
$homogeneous = FALSE if(!defined $homogeneous);
|
$homogeneous = FALSE if(!defined $homogeneous);
|
my $box = def_hbox($homogeneous,0);
|
my $box = def_hbox($homogeneous,0);
|
my $image = def_icon($image_file) if(-f $image_file);
|
my $image = def_icon($image_file) if(-f $image_file);
|
|
|
|
|
# now on to the image stuff
|
# now on to the image stuff
|
#my $image = Gtk2::Image->new_from_file($image_file);
|
#my $image = Gtk2::Image->new_from_file($image_file);
|
$box->pack_start($image, FALSE, FALSE, 0) if(-f $image_file);
|
$box->pack_start($image, FALSE, FALSE, 0) if(-f $image_file);
|
$box->set_border_width(0);
|
$box->set_border_width(0);
|
$box->set_spacing (0);
|
$box->set_spacing (0);
|
# Create a label for the button
|
# Create a label for the button
|
if(defined $label_text ) {
|
if(defined $label_text ) {
|
my $label = Gtk2::Label->new(" $label_text");
|
my $label = Gtk2::Label->new(" $label_text");
|
$box->pack_start($label, FALSE, FALSE, 0);
|
$box->pack_start($label, FALSE, FALSE, 0);
|
}
|
}
|
|
|
|
|
my $button = Gtk2::Button->new();
|
my $button = Gtk2::Button->new();
|
$button->add($box);
|
$button->add($box);
|
$button->set_border_width(0);
|
$button->set_border_width(0);
|
$button->show_all;
|
$button->show_all;
|
return $button;
|
return $button;
|
|
|
}
|
}
|
|
|
|
|
sub def_image_label{
|
sub def_image_label{
|
my ($image_file, $label_text)=@_;
|
my ($image_file, $label_text)=@_;
|
# create box for image and label
|
# create box for image and label
|
my $box = def_hbox(FALSE,1);
|
my $box = def_hbox(FALSE,1);
|
# now on to the image stuff
|
# now on to the image stuff
|
my $image = def_icon($image_file);
|
my $image = def_icon($image_file);
|
$box->pack_start($image, TRUE, FALSE, 0);
|
$box->pack_start($image, TRUE, FALSE, 0);
|
# Create a label for the button
|
# Create a label for the button
|
if(defined $label_text ) {
|
if(defined $label_text ) {
|
my $label = Gtk2::Label->new($label_text);
|
my $label = Gtk2::Label->new($label_text);
|
$box->pack_start($label, TRUE, FALSE, 0);
|
$box->pack_start($label, TRUE, FALSE, 0);
|
}
|
}
|
|
|
return $box;
|
return $box;
|
|
|
}
|
}
|
|
|
|
|
sub gen_button_message {
|
sub gen_button_message {
|
my ($help, $image_file,$label_name)= @_;
|
my ($help, $image_file,$label_name)= @_;
|
my $box = def_hbox(FALSE, 0);
|
my $box = def_hbox(FALSE, 0);
|
my $label= gen_label_in_center($label_name) if(defined $label_name);
|
my $label= gen_label_in_center($label_name) if(defined $label_name);
|
my $button=def_image_button($image_file);
|
my $button=def_image_button($image_file);
|
|
|
if(defined $help ){$button->signal_connect("clicked" => sub {message_dialog($help);});}
|
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( $label, FALSE, FALSE, 0) if(defined $label_name);
|
$box->pack_start( $button, FALSE, FALSE, 0);
|
$box->pack_start( $button, FALSE, FALSE, 0);
|
$box->set_border_width(0);
|
$box->set_border_width(0);
|
$box->set_spacing (0);
|
$box->set_spacing (0);
|
$box->show_all;
|
$box->show_all;
|
|
|
return $box;
|
return $box;
|
|
|
|
|
}
|
}
|
|
|
|
|
sub def_colored_button{
|
sub def_colored_button{
|
my ($label_text,$color_num)=@_;
|
my ($label_text,$color_num)=@_;
|
# create box for image and label
|
# create box for image and label
|
my $box = def_hbox(FALSE,0);
|
my $box = def_hbox(FALSE,0);
|
my $font_size=get_defualt_font_size();
|
my $font_size=get_defualt_font_size();
|
my $size=($font_size==10)? 25:
|
my $size=($font_size==10)? 25:
|
($font_size==9 )? 22:
|
($font_size==9 )? 22:
|
($font_size==8 )? 18:
|
($font_size==8 )? 18:
|
($font_size==7 )? 15:12 ;
|
($font_size==7 )? 15:12 ;
|
$box->set_border_width(0);
|
$box->set_border_width(0);
|
$box->set_spacing (0);
|
$box->set_spacing (0);
|
# Create a label for the button
|
# Create a label for the button
|
if(defined $label_text ) {
|
if(defined $label_text ) {
|
my $label = gen_label_in_center("$label_text");
|
my $label = gen_label_in_center("$label_text");
|
$box->pack_start($label, TRUE, TRUE, 0);
|
$box->pack_start($label, TRUE, TRUE, 0);
|
}
|
}
|
my @clr_code=get_color($color_num);
|
my @clr_code=get_color($color_num);
|
my $color = Gtk2::Gdk::Color->new (@clr_code);
|
my $color = Gtk2::Gdk::Color->new (@clr_code);
|
|
|
my $button = Gtk2::Button->new();
|
my $button = Gtk2::Button->new();
|
$button->modify_bg('normal',$color);
|
$button->modify_bg('normal',$color);
|
$button->add($box);
|
$button->add($box);
|
$button->set_border_width(0);
|
$button->set_border_width(0);
|
$button->show_all;
|
$button->show_all;
|
return $button;
|
return $button;
|
|
|
}
|
}
|
|
|
|
|
|
|
|
|
sub show_gif{
|
sub show_gif{
|
|
|
my $gif = shift;
|
my $gif = shift;
|
#my $mw=def_popwin_size(400,200,'hey');
|
#my $mw=def_popwin_size(400,200,'hey');
|
my $vbox = Gtk2::HBox->new (TRUE, 8);
|
my $vbox = Gtk2::HBox->new (TRUE, 8);
|
my $filename;
|
my $filename;
|
eval {
|
eval {
|
## $filename = demo_find_file ("floppybuddy.gif");
|
## $filename = demo_find_file ("floppybuddy.gif");
|
$filename = main::demo_find_file ($gif);
|
$filename = main::demo_find_file ($gif);
|
};
|
};
|
|
|
|
|
my $image = Gtk2::Image->new_from_file ($gif);
|
my $image = Gtk2::Image->new_from_file ($gif);
|
|
|
$vbox->set_border_width (4);
|
$vbox->set_border_width (4);
|
my $align = Gtk2::Alignment->new (0.5, 0.5, 0, 0);
|
my $align = Gtk2::Alignment->new (0.5, 0.5, 0, 0);
|
|
|
my $frame = Gtk2::Frame->new;
|
my $frame = Gtk2::Frame->new;
|
$frame->set_shadow_type ('in');
|
$frame->set_shadow_type ('in');
|
|
|
|
|
|
|
|
|
# Animation
|
# Animation
|
$frame->add ($image);
|
$frame->add ($image);
|
$align->add ($frame);
|
$align->add ($frame);
|
|
|
|
|
|
|
|
|
$vbox->pack_start ($align, FALSE, FALSE, 0);
|
$vbox->pack_start ($align, FALSE, FALSE, 0);
|
|
|
# $mw->add ($vbox);
|
# $mw->add ($vbox);
|
|
|
|
|
# Progressive
|
# Progressive
|
|
|
|
|
|
|
|
|
#$mw->show_all();
|
#$mw->show_all();
|
return $vbox;
|
return $vbox;
|
|
|
|
|
|
|
|
|
}
|
}
|
|
|
############
|
############
|
# message_dialog
|
# message_dialog
|
############
|
############
|
|
|
sub message_dialog {
|
sub message_dialog {
|
my ($message,$type)=@_;
|
my ($message,$type)=@_;
|
$type = 'info' if (!defined $type);
|
$type = 'info' if (!defined $type);
|
my $window;
|
my $window;
|
my $dialog = Gtk2::MessageDialog->new ($window,
|
my $dialog = Gtk2::MessageDialog->new ($window,
|
[qw/modal destroy-with-parent/],
|
[qw/modal destroy-with-parent/],
|
$type,
|
$type,
|
'ok',
|
'ok',
|
$message);
|
$message);
|
$dialog->run;
|
$dialog->run;
|
$dialog->destroy;
|
$dialog->destroy;
|
|
|
}
|
}
|
|
|
|
|
|
|
|
sub set_tip{
|
|
my ($widget,$tip)=@_;
|
|
my $tooltips = Gtk2::Tooltips->new;
|
|
$tooltips->set_tip($widget,$tip);
|
|
|
|
|
|
}
|
|
|
|
|
############
|
############
|
# window
|
# window
|
###########
|
###########
|
|
|
sub def_win {
|
sub def_win {
|
my @titel=shift;
|
my @titel=shift;
|
my $window = Gtk2::Window->new('toplevel');
|
my $window = Gtk2::Window->new('toplevel');
|
$window->set_title(@titel);
|
$window->set_title(@titel);
|
$window->set_position("center");
|
$window->set_position("center");
|
$window->set_default_size(100, 100);
|
$window->set_default_size(100, 100);
|
$window->set_border_width(20);
|
$window->set_border_width(20);
|
$window->signal_connect (delete_event => sub { Gtk2->main_quit });
|
$window->signal_connect (delete_event => sub { Gtk2->main_quit });
|
return $window;
|
return $window;
|
|
|
}
|
}
|
|
|
|
|
sub def_win_size {
|
sub def_win_size {
|
my $x=shift;
|
my $x=shift;
|
my $y=shift;
|
my $y=shift;
|
my @titel=shift;
|
my @titel=shift;
|
my $window = Gtk2::Window->new('toplevel');
|
my $window = Gtk2::Window->new('toplevel');
|
$window->set_title(@titel);
|
$window->set_title(@titel);
|
$window->set_position("center");
|
$window->set_position("center");
|
$window->set_default_size($x, $y);
|
$window->set_default_size($x, $y);
|
$window->set_border_width(20);
|
$window->set_border_width(20);
|
$window->signal_connect (delete_event => sub { Gtk2->main_quit });
|
$window->signal_connect (delete_event => sub { Gtk2->main_quit });
|
return $window;
|
return $window;
|
|
|
}
|
}
|
|
|
|
|
sub def_popwin_size {
|
sub def_popwin_size {
|
my ($x,$y,$titel,$unit)=@_;
|
my ($x,$y,$titel,$unit)=@_;
|
if(defined $unit){
|
if(defined $unit){
|
my($width,$hight)=max_win_size();
|
my($width,$hight)=max_win_size();
|
if($unit eq 'percent'){
|
if($unit eq 'percent'){
|
$x= ($x * $width)/100;
|
$x= ($x * $width)/100;
|
$y= ($y * $hight)/100;
|
$y= ($y * $hight)/100;
|
} # else its pixels
|
} # else its pixels
|
|
|
}
|
}
|
#my $window = Gtk2::Window->new('popup');
|
#my $window = Gtk2::Window->new('popup');
|
my $window = Gtk2::Window->new('toplevel');
|
my $window = Gtk2::Window->new('toplevel');
|
$window->set_title($titel);
|
$window->set_title($titel);
|
$window->set_position("center");
|
$window->set_position("center");
|
$window->set_default_size($x, $y);
|
$window->set_default_size($x, $y);
|
$window->set_border_width(20);
|
$window->set_border_width(20);
|
$window->signal_connect (delete_event => sub { $window->destroy });
|
$window->signal_connect (delete_event => sub { $window->destroy });
|
return $window;
|
return $window;
|
|
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
sub def_scrolled_window_box{
|
sub def_scrolled_window_box{
|
|
|
my $window = def_popwin_size(@_);
|
my $window = def_popwin_size(@_);
|
my $box=def_vbox(TRUE,5);
|
my $box=def_vbox(TRUE,5);
|
my $scrolled_window = new Gtk2::ScrolledWindow (undef, undef);
|
my $scrolled_window = new Gtk2::ScrolledWindow (undef, undef);
|
$scrolled_window->set_policy( "automatic", "automatic" );
|
$scrolled_window->set_policy( "automatic", "automatic" );
|
$scrolled_window->add_with_viewport($box);
|
$scrolled_window->add_with_viewport($box);
|
|
|
|
|
|
|
$window->add($scrolled_window);
|
$window->add($scrolled_window);
|
$window->show_all;
|
$window->show_all;
|
$box->show_all;
|
$box->show_all;
|
|
|
return ($box,$window);
|
return ($box,$window);
|
|
|
}
|
}
|
|
|
sub max_win_size{
|
sub max_win_size{
|
my $screen =Gtk2::Gdk::Screen->get_default();
|
my $screen =Gtk2::Gdk::Screen->get_default();
|
my $hight = $screen->get_height();
|
my $hight = $screen->get_height();
|
my $width = $screen->get_width();
|
my $width = $screen->get_width();
|
return ($width,$hight);
|
return ($width,$hight);
|
}
|
}
|
|
|
|
|
sub get_defualt_font_size{
|
sub get_defualt_font_size{
|
my($width,$hight)=max_win_size();
|
my($width,$hight)=max_win_size();
|
#print "($width,$hight)\n";
|
#print "($width,$hight)\n";
|
my $font_size=($width>=1600)? 10:
|
my $font_size=($width>=1600)? 10:
|
($width>=1400)? 9:
|
($width>=1400)? 9:
|
($width>=1200)? 9:
|
($width>=1200)? 9:
|
($width>=1000)? 7:6;
|
($width>=1000)? 7:6;
|
#print "$font_size\n";
|
#print "$font_size\n";
|
return $font_size;
|
return $font_size;
|
}
|
}
|
|
|
|
|
sub set_defualt_font_size{
|
sub set_defualt_font_size{
|
my $font_size=get_defualt_font_size();
|
my $font_size=get_defualt_font_size();
|
|
|
Gtk2::Rc->parse_string(<<__);
|
Gtk2::Rc->parse_string(<<__);
|
style "normal" {
|
style "normal" {
|
font_name ="Verdana $font_size"
|
font_name ="Verdana $font_size"
|
}
|
}
|
widget "*" style "normal"
|
widget "*" style "normal"
|
__
|
__
|
|
|
}
|
}
|
|
|
|
sub gen_scr_win_with_adjst {
|
|
my ($self,$name)=@_;
|
|
my $scrolled_win = new Gtk2::ScrolledWindow (undef, undef);
|
|
$scrolled_win->set_policy( "automatic", "automatic" );
|
|
$scrolled_win->signal_connect("destroy"=> sub{
|
|
save_scrolled_win_adj($self,$scrolled_win, $name);
|
|
|
|
});
|
|
my $adjast=0;
|
|
$scrolled_win->signal_connect("size-allocate"=> sub{
|
|
if($adjast==0){
|
|
load_scrolled_win_adj($self,$scrolled_win, $name);
|
|
$adjast=1;
|
|
}
|
|
|
|
});
|
|
return $scrolled_win;
|
|
}
|
|
|
|
|
|
sub save_scrolled_win_adj {
|
|
my ($self,$scrolled_win,$name)=@_;
|
|
my $ha= $scrolled_win->get_hadjustment();
|
|
my $va =$scrolled_win->get_vadjustment();
|
|
return if(!defined $ha);
|
|
return if(!defined $va);
|
|
save_adj ($self,$ha,$name,"ha");
|
|
save_adj ($self,$va,$name,"va");
|
|
}
|
|
|
|
|
|
sub load_scrolled_win_adj {
|
|
my ($self,$scrolled_win,$name)=@_;
|
|
my $ha= $scrolled_win->get_hadjustment();
|
|
my $va =$scrolled_win->get_vadjustment();
|
|
my $h=load_adj ($self,$ha,$name,"ha");
|
|
my $v=load_adj ($self,$va,$name,"va");
|
|
#$ha->set_value($h) if(defined $h);
|
|
#$va->set_value($v) if(defined $v);
|
|
}
|
|
|
|
|
|
|
|
|
|
sub save_adj {
|
|
my ($self,$adjustment,$at1,$at2)=@_;
|
|
my $value = $adjustment->value;
|
|
$self->object_add_attribute($at1,$at2,$value);
|
|
}
|
|
|
|
|
|
sub load_adj {
|
|
my ($self,$adjustment,$at1,$at2)=@_;
|
|
return if(!defined $at1);
|
|
my $value= $self->object_get_attribute($at1,$at2);
|
|
return if(!defined $value);
|
|
my $lower = $adjustment->lower;
|
|
my $upper = $adjustment->upper - $adjustment->page_size;
|
|
$value= ($value < $lower || $value > $upper ) ? 0 : $value;
|
|
|
|
$adjustment->set_value($value);
|
|
}
|
|
|
|
|
##############
|
##############
|
# box
|
# box
|
#############
|
#############
|
|
|
sub def_hbox {
|
sub def_hbox {
|
my( $homogeneous, $spacing)=@_;
|
my( $homogeneous, $spacing)=@_;
|
my $box = Gtk2::HBox->new($homogeneous, $spacing);
|
my $box = Gtk2::HBox->new($homogeneous, $spacing);
|
$box->set_border_width(2);
|
$box->set_border_width(2);
|
return $box;
|
return $box;
|
}
|
}
|
|
|
sub def_vbox {
|
sub def_vbox {
|
my $box = Gtk2::VBox->new(FALSE, 0);
|
my $box = Gtk2::VBox->new(FALSE, 0);
|
$box->set_border_width(2);
|
$box->set_border_width(2);
|
return $box;
|
return $box;
|
}
|
}
|
|
|
sub def_pack_hbox{
|
sub def_pack_hbox{
|
my( $homogeneous, $spacing , @box_list)=@_;
|
my( $homogeneous, $spacing , @box_list)=@_;
|
my $box=def_hbox($homogeneous, $spacing);
|
my $box=def_hbox($homogeneous, $spacing);
|
foreach my $subbox (@box_list){
|
foreach my $subbox (@box_list){
|
$box->pack_start( $subbox, FALSE, FALSE, 3);
|
$box->pack_start( $subbox, FALSE, FALSE, 3);
|
}
|
}
|
return $box;
|
return $box;
|
|
|
|
|
}
|
}
|
|
|
sub def_pack_vbox{
|
sub def_pack_vbox{
|
my( $homogeneous, $spacing , @box_list)=@_;
|
my( $homogeneous, $spacing , @box_list)=@_;
|
my $box=def_vbox($homogeneous, $spacing);
|
my $box=def_vbox($homogeneous, $spacing);
|
foreach my $subbox (@box_list){
|
foreach my $subbox (@box_list){
|
$box->pack_start( $subbox, FALSE, FALSE, 3);
|
$box->pack_start( $subbox, FALSE, FALSE, 3);
|
}
|
}
|
return $box;
|
return $box;
|
|
|
}
|
}
|
|
|
|
|
##########
|
##########
|
# Paned
|
# Paned
|
#########
|
#########
|
|
|
|
|
sub gen_vpaned {
|
sub gen_vpaned {
|
my ($w1,$loc,$w2) = @_;
|
my ($w1,$loc,$w2) = @_;
|
my $vpaned = Gtk2::VPaned -> new;
|
my $vpaned = Gtk2::VPaned -> new;
|
my($width,$hight)=max_win_size();
|
my($width,$hight)=max_win_size();
|
|
|
|
|
$vpaned -> pack1($w1, TRUE, TRUE);
|
$vpaned -> pack1($w1, TRUE, TRUE);
|
$vpaned -> set_position ($hight*$loc);
|
$vpaned -> set_position ($hight*$loc);
|
$vpaned -> pack2($w2, TRUE, TRUE);
|
$vpaned -> pack2($w2, TRUE, TRUE);
|
|
|
return $vpaned;
|
return $vpaned;
|
}
|
}
|
|
|
|
|
sub gen_hpaned {
|
sub gen_hpaned {
|
my ($w1,$loc,$w2) = @_;
|
my ($w1,$loc,$w2) = @_;
|
my $hpaned = Gtk2::HPaned -> new;
|
my $hpaned = Gtk2::HPaned -> new;
|
my($width,$hight)=max_win_size();
|
my($width,$hight)=max_win_size();
|
|
|
|
|
$hpaned -> pack1($w1, TRUE, TRUE);
|
$hpaned -> pack1($w1, TRUE, TRUE);
|
$hpaned -> set_position ($width*$loc);
|
$hpaned -> set_position ($width*$loc);
|
$hpaned -> pack2($w2, TRUE, TRUE);
|
$hpaned -> pack2($w2, TRUE, TRUE);
|
|
|
return $hpaned;
|
return $hpaned;
|
}
|
}
|
|
|
#############
|
#############
|
# text_view
|
# text_view
|
############
|
############
|
|
|
sub create_text {
|
sub create_text {
|
my $scrolled_window = Gtk2::ScrolledWindow->new;
|
my $scrolled_window = Gtk2::ScrolledWindow->new;
|
$scrolled_window->set_policy ('automatic', 'automatic');
|
$scrolled_window->set_policy ('automatic', 'automatic');
|
$scrolled_window->set_shadow_type ('in');
|
$scrolled_window->set_shadow_type ('in');
|
my $tview = Gtk2::TextView->new();
|
my $tview = Gtk2::TextView->new();
|
$scrolled_window->add ($tview);
|
$scrolled_window->add ($tview);
|
$tview->show_all;
|
$tview->show_all;
|
# Make it a bit nicer for text.
|
# Make it a bit nicer for text.
|
$tview->set_wrap_mode ('word');
|
$tview->set_wrap_mode ('word');
|
$tview->set_pixels_above_lines (2);
|
$tview->set_pixels_above_lines (2);
|
$tview->set_pixels_below_lines (2);
|
$tview->set_pixels_below_lines (2);
|
|
# $scrolled_window->set_placement('bottom_left' );
|
return ($scrolled_window,$tview);
|
return ($scrolled_window,$tview);
|
}
|
}
|
|
|
|
|
#################
|
#################
|
# table
|
# table
|
################
|
################
|
|
|
sub def_table{
|
sub def_table{
|
my ($row,$col,$homogeneous)=@_;
|
my ($row,$col,$homogeneous)=@_;
|
my $table = Gtk2::Table->new ($row, $col, $homogeneous);
|
my $table = Gtk2::Table->new ($row, $col, $homogeneous);
|
$table->set_row_spacings (0);
|
$table->set_row_spacings (0);
|
$table->set_col_spacings (0);
|
$table->set_col_spacings (0);
|
return $table;
|
return $table;
|
|
|
}
|
}
|
|
|
|
sub attach_widget_to_table {
|
|
my ($table,$row,$label,$inf_bt,$widget,$column)=@_;
|
|
$column = 0 if(!defined $column);
|
|
$column *=4;
|
|
#my $tmp=gen_label_in_left(" ");
|
|
if(defined $label) {$table->attach ($label , $column, $column+1, $row,$row+1,'fill','shrink',2,2);$column++;}
|
|
if(defined $inf_bt) {$table->attach ($inf_bt , $column, $column+1, $row,$row+1,'fill','shrink',2,2);$column++;}
|
|
if(defined $widget) {$table->attach ($widget , $column, $column+1, $row,$row+1,'fill','shrink',2,2);$column++;}
|
|
#$table->attach ($tmp , $column+3, $column+4, $row,$row+1,'fill','shrink',2,2);
|
|
}
|
|
|
|
|
|
#sub attach_widget_to_table2 {
|
|
# my ($table,$row,$label,$inf_bt,$widget)=@_;
|
|
|
|
# my $tmp=gen_label_in_left(" ");
|
|
# $table->attach ($label , 0, 4, $row,$row+1,'fill','shrink',2,2);
|
|
# $table->attach ($inf_bt , 4, 5, $row,$row+1,'fill','shrink',2,2);
|
|
# $table->attach ($widget , 5, 9, $row,$row+1,'fill','shrink',2,2);
|
|
# $table->attach ($tmp , 9, 10, $row,$row+1,'fill','shrink',2,2);
|
|
#}
|
|
|
|
|
######
|
######
|
# state
|
# state
|
#####
|
#####
|
|
|
sub def_state{
|
sub def_state{
|
my ($initial)=@_;
|
my ($initial)=@_;
|
my $entry = Gtk2::Entry->new;
|
my $entry = Gtk2::Entry->new;
|
$entry->set_text($initial);
|
$entry->set_text($initial);
|
my $timeout=0;
|
my $timeout=0;
|
my @state= ($entry,$timeout);
|
my @state= ($entry,$timeout);
|
return \@state
|
return \@state
|
|
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
sub set_gui_status{
|
sub set_gui_status{
|
my ($object,$status,$timeout)=@_;
|
my ($object,$status,$timeout)=@_;
|
$object->object_add_attribute('gui_status','status',$status);
|
$object->object_add_attribute('gui_status','status',$status);
|
$object->object_add_attribute('gui_status','timeout',$timeout);
|
$object->object_add_attribute('gui_status','timeout',$timeout);
|
}
|
}
|
|
|
|
|
sub get_gui_status{
|
sub get_gui_status{
|
my ($object)=@_;
|
my ($object)=@_;
|
my $status= $object->object_get_attribute('gui_status','status');
|
my $status= $object->object_get_attribute('gui_status','status');
|
my $timeout=$object->object_get_attribute('gui_status','timeout');
|
my $timeout=$object->object_get_attribute('gui_status','timeout');
|
return ($status,$timeout);
|
return ($status,$timeout);
|
}
|
}
|
|
|
|
|
|
|
##################
|
##################
|
# show_info
|
# show_info
|
##################
|
##################
|
sub show_info{
|
sub show_info{
|
my ($textview_ref,$info)=@_;
|
my ($textview_ref,$info)=@_;
|
my $buffer = $$textview_ref->get_buffer();
|
my $buffer = $$textview_ref->get_buffer();
|
$buffer->set_text($info);
|
$buffer->set_text($info);
|
}
|
}
|
|
|
sub add_info{
|
sub add_info{
|
my ($textview_ref,$info)=@_;
|
my ($textview_ref,$info)=@_;
|
my $buffer = $$textview_ref->get_buffer();
|
my $buffer = $$textview_ref->get_buffer();
|
my $textiter = $buffer->get_end_iter();
|
my $textiter = $buffer->get_end_iter();
|
#Insert some text into the buffer
|
#Insert some text into the buffer
|
$buffer->insert($textiter,$info);
|
$buffer->insert($textiter,$info);
|
|
|
}
|
}
|
|
|
|
|
|
sub new_on_textview{
|
|
my ($textview,$info)=@_;
|
|
my $buffer = $textview->get_buffer();
|
|
$buffer->set_text($info);
|
|
}
|
|
|
|
sub append_to_textview{
|
|
my ($textview,$info)=@_;
|
|
my $buffer = $textview->get_buffer();
|
|
my $textiter = $buffer->get_end_iter();
|
|
#Insert some text into the buffer
|
|
$buffer->insert($textiter,$info);
|
|
|
|
|
|
}
|
|
|
|
|
sub show_colored_info{
|
sub show_colored_info{
|
my ($textview_ref,$info,$color)=@_;
|
my ($textview_ref,$info,$color)=@_;
|
my $buffer = $$textview_ref->get_buffer();
|
my $buffer = $$textview_ref->get_buffer();
|
#$buffer->set_text($info);
|
#$buffer->set_text($info);
|
my $textiter = $buffer->get_start_iter();
|
my $textiter = $buffer->get_start_iter();
|
$buffer->insert_with_tags_by_name ($textiter, "$info", "${color}_tag");
|
$buffer->insert_with_tags_by_name ($textiter, "$info", "${color}_tag");
|
}
|
}
|
|
|
sub add_colored_info{
|
sub add_colored_info{
|
my ($textview_ref,$info,$color)=@_;
|
my ($textview_ref,$info,$color)=@_;
|
my $buffer = $$textview_ref->get_buffer();
|
my $buffer = $$textview_ref->get_buffer();
|
my $textiter = $buffer->get_end_iter();
|
my $textiter = $buffer->get_end_iter();
|
#Insert some text into the buffer
|
#Insert some text into the buffer
|
#$buffer->insert($textiter,$info);
|
#$buffer->insert($textiter,$info);
|
$buffer->insert_with_tags_by_name ($textiter, "$info", "${color}_tag");
|
$buffer->insert_with_tags_by_name ($textiter, "$info", "${color}_tag");
|
|
|
}
|
}
|
|
|
|
sub add_colors_to_textview{
|
|
my $tview= shift;
|
|
add_colored_tag($tview,'red');
|
|
add_colored_tag($tview,'blue');
|
|
add_colored_tag($tview,'green');
|
|
}
|
|
|
|
|
sub add_colored_tag{
|
sub add_colored_tag{
|
my ($textview_ref,$color)=@_;
|
my ($textview_ref,$color)=@_;
|
my $buffer = $textview_ref->get_buffer();
|
my $buffer = $textview_ref->get_buffer();
|
$buffer->create_tag ("${color}_tag", foreground => $color);
|
$buffer->create_tag ("${color}_tag", foreground => $color);
|
}
|
}
|
|
|
|
|
|
|
####################
|
####################
|
# file
|
# file
|
##################
|
##################
|
|
|
|
|
sub read_verilog_file{
|
sub read_verilog_file{
|
my @files = @_;
|
my @files = @_;
|
my %cmd_line_defines = ();
|
my %cmd_line_defines = ();
|
my $quiet = 1;
|
my $quiet = 1;
|
my @inc_dirs = ();
|
my @inc_dirs = ();
|
my @lib_dirs = ();
|
my @lib_dirs = ();
|
my @lib_exts = ();
|
my @lib_exts = ();
|
my $vdb = rvp->read_verilog(\@files,[],\%cmd_line_defines,
|
my $vdb = rvp->read_verilog(\@files,[],\%cmd_line_defines,
|
$quiet,\@inc_dirs,\@lib_dirs,\@lib_exts);
|
$quiet,\@inc_dirs,\@lib_dirs,\@lib_exts);
|
|
|
my @problems = $vdb->get_problems();
|
my @problems = $vdb->get_problems();
|
if (@problems) {
|
if (@problems) {
|
foreach my $problem ($vdb->get_problems()) {
|
foreach my $problem ($vdb->get_problems()) {
|
print STDERR "$problem.\n";
|
print STDERR "$problem.\n";
|
}
|
}
|
# die "Warnings parsing files!";
|
# die "Warnings parsing files!";
|
}
|
}
|
|
|
return $vdb;
|
return $vdb;
|
}
|
}
|
|
|
sub add_color_to_gd{
|
sub add_color_to_gd{
|
foreach (my $i=0;$i<32;$i++ ) {
|
foreach (my $i=0;$i<32;$i++ ) {
|
my ($red,$green,$blue)=get_color($i);
|
my ($red,$green,$blue)=get_color($i);
|
add_colour("my_color$i"=>[$red>>8,$green>>8,$blue>>8]);
|
add_colour("my_color$i"=>[$red>>8,$green>>8,$blue>>8]);
|
|
|
}
|
}
|
}
|
}
|
|
|
|
|
|
|
sub append_text_to_file {
|
sub append_text_to_file {
|
my ($file_path,$text)=@_;
|
my ($file_path,$text)=@_;
|
open(my $fd, ">>$file_path");
|
open(my $fd, ">>$file_path");
|
print $fd $text;
|
print $fd $text;
|
close $fd;
|
close $fd;
|
}
|
}
|
|
|
|
|
|
|
|
|
sub save_file {
|
sub save_file {
|
my ($file_path,$text)=@_;
|
my ($file_path,$text)=@_;
|
open(my $fd, ">$file_path");
|
open my $fd, ">$file_path" or die "could not open $file_path: $!";
|
print $fd $text;
|
print $fd $text;
|
close $fd;
|
close $fd;
|
}
|
}
|
|
|
sub load_file {
|
sub load_file {
|
my $file_path=shift;
|
my $file_path=shift;
|
my $str;
|
my $str;
|
if (-f "$file_path") {
|
if (-f "$file_path") {
|
|
|
$str = do {
|
$str = do {
|
local $/ = undef;
|
local $/ = undef;
|
open my $fh, "<", $file_path
|
open my $fh, "<", $file_path
|
or die "could not open $file_path: $!";
|
or die "could not open $file_path: $!";
|
<$fh>;
|
<$fh>;
|
};
|
};
|
|
|
}
|
}
|
return $str;
|
return $str;
|
}
|
}
|
|
|
|
|
|
|
|
|
sub merg_files {
|
sub merg_files {
|
my ($source_file_path,$dest_file_path)=@_;
|
my ($source_file_path,$dest_file_path)=@_;
|
local $/=undef;
|
local $/=undef;
|
open FILE, $source_file_path or die "Couldn't open file: $!";
|
open FILE, $source_file_path or die "Couldn't open file: $!";
|
my $string = <FILE>;
|
my $string = <FILE>;
|
close FILE;
|
close FILE;
|
append_text_to_file ($dest_file_path,$string);
|
append_text_to_file ($dest_file_path,$string);
|
}
|
}
|
|
|
|
|
|
|
sub copy_file_and_folders{
|
sub copy_file_and_folders{
|
my ($file_ref,$project_dir,$target_dir)=@_;
|
my ($file_ref,$project_dir,$target_dir)=@_;
|
|
|
foreach my $f(@{$file_ref}){
|
foreach my $f(@{$file_ref}){
|
my $name= basename($f);
|
my $name= basename($f);
|
my $n="$project_dir$f";
|
my $n="$project_dir$f";
|
if (-f "$n") { #copy file
|
if (-f "$n") { #copy file
|
copy ("$n","$target_dir");
|
copy ("$n","$target_dir");
|
}elsif(-f "$f" ){
|
}elsif(-f "$f" ){
|
copy ("$f","$target_dir");
|
copy ("$f","$target_dir");
|
}elsif (-d "$n") {#copy folder
|
}elsif (-d "$n") {#copy folder
|
dircopy ("$n","$target_dir/$name");
|
dircopy ("$n","$target_dir/$name");
|
}elsif(-d "$f" ){
|
}elsif(-d "$f" ){
|
dircopy ("$f","$target_dir/$name");
|
dircopy ("$f","$target_dir/$name");
|
|
|
}
|
}
|
}
|
}
|
|
|
}
|
}
|
|
|
sub read_file_cntent {
|
sub read_file_cntent {
|
my ($f,$project_dir)=@_;
|
my ($f,$project_dir)=@_;
|
my $n="$project_dir$f";
|
my $n="$project_dir$f";
|
my $str;
|
my $str;
|
if (-f "$n") {
|
if (-f "$n") {
|
|
|
$str = do {
|
$str = do {
|
local $/ = undef;
|
local $/ = undef;
|
open my $fh, "<", $n
|
open my $fh, "<", $n
|
or die "could not open $n: $!";
|
or die "could not open $n: $!";
|
<$fh>;
|
<$fh>;
|
};
|
};
|
|
|
}elsif(-f "$f" ){
|
}elsif(-f "$f" ){
|
$str = do {
|
$str = do {
|
local $/ = undef;
|
local $/ = undef;
|
open my $fh, "<", $f
|
open my $fh, "<", $f
|
or die "could not open $f: $!";
|
or die "could not open $f: $!";
|
<$fh>;
|
<$fh>;
|
};
|
};
|
|
|
|
|
}
|
}
|
return $str;
|
return $str;
|
|
|
}
|
}
|
|
|
|
|
sub check_file_has_string {
|
sub check_file_has_string {
|
my ($file,$string)=@_;
|
my ($file,$string)=@_;
|
my $r;
|
my $r;
|
open(FILE,$file);
|
open(FILE,$file);
|
if (grep{/$string/} <FILE>){
|
if (grep{/$string/} <FILE>){
|
$r= 1; #print "word found\n";
|
$r= 1; #print "word found\n";
|
}else{
|
}else{
|
$r= 0; #print "word not found\n";
|
$r= 0; #print "word not found\n";
|
}
|
}
|
close FILE;
|
close FILE;
|
return $r;
|
return $r;
|
}
|
}
|
|
|
|
|
###########
|
###########
|
# color
|
# color
|
#########
|
#########
|
|
|
|
|
|
|
|
|
|
|
|
|
sub get_color {
|
sub get_color {
|
my $num=shift;
|
my $num=shift;
|
|
|
my @colors=(
|
my @colors=(
|
0x6495ED,#Cornflower Blue
|
0x6495ED,#Cornflower Blue
|
0xFAEBD7,#Antiquewhite
|
0xFAEBD7,#Antiquewhite
|
0xC71585,#Violet Red
|
0xC71585,#Violet Red
|
0xC0C0C0,#silver
|
0xC0C0C0,#silver
|
0xADD8E6,#Lightblue
|
0xADD8E6,#Lightblue
|
0x6A5ACD,#Slate Blue
|
0x6A5ACD,#Slate Blue
|
0x00CED1,#Dark Turquoise
|
0x00CED1,#Dark Turquoise
|
0x008080,#Teal
|
0x008080,#Teal
|
0x2E8B57,#SeaGreen
|
0x2E8B57,#SeaGreen
|
0xFFB6C1,#Light Pink
|
0xFFB6C1,#Light Pink
|
0x008000,#Green
|
0x008000,#Green
|
0xFF0000,#red
|
0xFF0000,#red
|
0x808080,#Gray
|
0x808080,#Gray
|
0x808000,#Olive
|
0x808000,#Olive
|
0xFF69B4,#Hot Pink
|
0xFF69B4,#Hot Pink
|
0xFFD700,#Gold
|
0xFFD700,#Gold
|
0xDAA520,#Goldenrod
|
0xDAA520,#Goldenrod
|
0xFFA500,#Orange
|
0xFFA500,#Orange
|
0x32CD32,#LimeGreen
|
0x32CD32,#LimeGreen
|
0x0000FF,#Blue
|
0x0000FF,#Blue
|
0xFF8C00,#DarkOrange
|
0xFF8C00,#DarkOrange
|
0xA0522D,#Sienna
|
0xA0522D,#Sienna
|
0xFF6347,#Tomato
|
0xFF6347,#Tomato
|
0x0000CD,#Medium Blue
|
0x0000CD,#Medium Blue
|
0xFF4500,#OrangeRed
|
0xFF4500,#OrangeRed
|
0xDC143C,#Crimson
|
0xDC143C,#Crimson
|
0x9932CC,#Dark Orchid
|
0x9932CC,#Dark Orchid
|
0x800000,#marron
|
0x800000,#marron
|
0x800080,#Purple
|
0x800080,#Purple
|
0x4B0082,#Indigo
|
0x4B0082,#Indigo
|
0xFFFFFF,#white
|
0xFFFFFF,#white
|
0x000000 #Black
|
0x000000 #Black
|
);
|
);
|
|
|
my $color= ($num< scalar (@colors))? $colors[$num]: 0xFFFFFF;
|
my $color= ($num< scalar (@colors))? $colors[$num]: 0xFFFFFF;
|
my $red= ($color & 0xFF0000) >> 8;
|
my $red= ($color & 0xFF0000) >> 8;
|
my $green= ($color & 0x00FF00);
|
my $green= ($color & 0x00FF00);
|
my $blue= ($color & 0x0000FF) << 8;
|
my $blue= ($color & 0x0000FF) << 8;
|
|
|
return ($red,$green,$blue);
|
return ($red,$green,$blue);
|
|
|
}
|
}
|
|
|
|
|
sub get_color_hex_string {
|
sub get_color_hex_string {
|
my $num=shift;
|
my $num=shift;
|
|
|
my @colors=(
|
my @colors=(
|
"6495ED",#Cornflower Blue
|
"6495ED",#Cornflower Blue
|
"FAEBD7",#Antiquewhite
|
"FAEBD7",#Antiquewhite
|
"C71585",#Violet Red
|
"C71585",#Violet Red
|
"C0C0C0",#silver
|
"C0C0C0",#silver
|
"ADD8E6",#Lightblue
|
"ADD8E6",#Lightblue
|
"6A5ACD",#Slate Blue
|
"6A5ACD",#Slate Blue
|
"00CED1",#Dark Turquoise
|
"00CED1",#Dark Turquoise
|
"008080",#Teal
|
"008080",#Teal
|
"2E8B57",#SeaGreen
|
"2E8B57",#SeaGreen
|
"FFB6C1",#Light Pink
|
"FFB6C1",#Light Pink
|
"008000",#Green
|
"008000",#Green
|
"FF0000",#red
|
"FF0000",#red
|
"808080",#Gray
|
"808080",#Gray
|
"808000",#Olive
|
"808000",#Olive
|
"FF69B4",#Hot Pink
|
"FF69B4",#Hot Pink
|
"FFD700",#Gold
|
"FFD700",#Gold
|
"DAA520",#Goldenrod
|
"DAA520",#Goldenrod
|
"FFA500",#Orange
|
"FFA500",#Orange
|
"32CD32",#LimeGreen
|
"32CD32",#LimeGreen
|
"0000FF",#Blue
|
"0000FF",#Blue
|
"FF8C00",#DarkOrange
|
"FF8C00",#DarkOrange
|
"A0522D",#Sienna
|
"A0522D",#Sienna
|
"FF6347",#Tomato
|
"FF6347",#Tomato
|
"0000CD",#Medium Blue
|
"0000CD",#Medium Blue
|
"FF4500",#OrangeRed
|
"FF4500",#OrangeRed
|
"DC143C",#Crimson
|
"DC143C",#Crimson
|
"9932CC",#Dark Orchid
|
"9932CC",#Dark Orchid
|
"800000",#marron
|
"800000",#marron
|
"800080",#Purple
|
"800080",#Purple
|
"4B0082",#Indigo
|
"4B0082",#Indigo
|
"FFFFFF",#white
|
"FFFFFF",#white
|
"000000" #Black
|
"000000" #Black
|
);
|
);
|
|
|
my $color= ($num< scalar (@colors))? $colors[$num]: "FFFFFF";
|
my $color= ($num< scalar (@colors))? $colors[$num]: "FFFFFF";
|
return $color;
|
return $color;
|
|
|
}
|
}
|
|
|
|
|
|
|
##############
|
##############
|
# clone_obj
|
# clone_obj
|
#############
|
#############
|
|
|
sub clone_obj{
|
sub clone_obj{
|
my ($self,$clone)=@_;
|
my ($self,$clone)=@_;
|
|
|
foreach my $p (keys %$self){
|
foreach my $p (keys %$self){
|
delete ($self->{$p});
|
delete ($self->{$p});
|
}
|
}
|
foreach my $p (keys %$clone){
|
foreach my $p (keys %$clone){
|
$self->{$p}= $clone->{$p};
|
$self->{$p}= $clone->{$p};
|
my $ref= ref ($clone->{$p});
|
my $ref= ref ($clone->{$p});
|
if( $ref eq 'HASH' ){
|
if( $ref eq 'HASH' ){
|
|
|
foreach my $q (keys %{$clone->{$p}}){
|
foreach my $q (keys %{$clone->{$p}}){
|
$self->{$p}{$q}= $clone->{$p}{$q};
|
$self->{$p}{$q}= $clone->{$p}{$q};
|
my $ref= ref ($self->{$p}{$q});
|
my $ref= ref ($self->{$p}{$q});
|
if( $ref eq 'HASH' ){
|
if( $ref eq 'HASH' ){
|
|
|
foreach my $z (keys %{$clone->{$p}{$q}}){
|
foreach my $z (keys %{$clone->{$p}{$q}}){
|
$self->{$p}{$q}{$z}= $clone->{$p}{$q}{$z};
|
$self->{$p}{$q}{$z}= $clone->{$p}{$q}{$z};
|
my $ref= ref ($self->{$p}{$q}{$z});
|
my $ref= ref ($self->{$p}{$q}{$z});
|
if( $ref eq 'HASH' ){
|
if( $ref eq 'HASH' ){
|
|
|
foreach my $w (keys %{$clone->{$p}{$q}{$q}}){
|
foreach my $w (keys %{$clone->{$p}{$q}{$z}}){
|
$self->{$p}{$q}{$z}{$w}= $clone->{$p}{$q}{$z}{$w};
|
$self->{$p}{$q}{$z}{$w}= $clone->{$p}{$q}{$z}{$w};
|
my $ref= ref ($self->{$p}{$q}{$z}{$w});
|
my $ref= ref ($self->{$p}{$q}{$z}{$w});
|
if( $ref eq 'HASH' ){
|
if( $ref eq 'HASH' ){
|
|
|
|
|
foreach my $m (keys %{$clone->{$p}{$q}{$q}{$w}}){
|
foreach my $m (keys %{$clone->{$p}{$q}{$z}{$w}}){
|
$self->{$p}{$q}{$z}{$w}{$m}= $clone->{$p}{$q}{$z}{$w}{$m};
|
$self->{$p}{$q}{$z}{$w}{$m}= $clone->{$p}{$q}{$z}{$w}{$m};
|
my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m});
|
my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m});
|
if( $ref eq 'HASH' ){
|
if( $ref eq 'HASH' ){
|
|
|
foreach my $n (keys %{$clone->{$p}{$q}{$q}{$w}{$m}}){
|
foreach my $n (keys %{$clone->{$p}{$q}{$z}{$w}{$m}}){
|
$self->{$p}{$q}{$z}{$w}{$m}{$n}= $clone->{$p}{$q}{$z}{$w}{$m}{$n};
|
$self->{$p}{$q}{$z}{$w}{$m}{$n}= $clone->{$p}{$q}{$z}{$w}{$m}{$n};
|
my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m}{$n});
|
my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m}{$n});
|
if( $ref eq 'HASH' ){
|
if( $ref eq 'HASH' ){
|
|
|
foreach my $l (keys %{$clone->{$p}{$q}{$q}{$w}{$m}{$n}}){
|
foreach my $l (keys %{$clone->{$p}{$q}{$z}{$w}{$m}{$n}}){
|
$self->{$p}{$q}{$z}{$w}{$m}{$n}{$l}= $clone->{$p}{$q}{$z}{$w}{$m}{$n}{$l};
|
$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});
|
my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m}{$n}{$l});
|
if( $ref eq 'HASH' ){
|
if( $ref eq 'HASH' ){
|
}
|
}
|
}
|
}
|
|
|
}#if
|
}#if
|
}#n
|
}#n
|
}#if
|
}#if
|
}#m
|
}#m
|
}#if
|
}#if
|
}#w
|
}#w
|
}#if
|
}#if
|
}#z
|
}#z
|
}#if
|
}#if
|
}#q
|
}#q
|
}#if
|
}#if
|
}#p
|
}#p
|
}#sub
|
}#sub
|
|
|
|
|
############
|
############
|
# get file folder list
|
# get file folder list
|
###########
|
###########
|
|
|
sub get_directory_name {
|
sub get_directory_name {
|
my ($object,$title,$entry,$attribute1,$attribute2,$status,$timeout)= @_;
|
my ($object,$title,$entry,$attribute1,$attribute2,$status,$timeout)= @_;
|
my $browse= def_image_button("icons/browse.png");
|
my $browse= def_image_button("icons/browse.png");
|
|
|
$browse->signal_connect("clicked"=> sub{
|
$browse->signal_connect("clicked"=> sub{
|
my $entry_ref=$_[1];
|
my $entry_ref=$_[1];
|
my $file;
|
my $file;
|
$title ='select directory' if(!defined $title);
|
$title ='select directory' if(!defined $title);
|
my $dialog = Gtk2::FileChooserDialog->new(
|
my $dialog = Gtk2::FileChooserDialog->new(
|
$title, undef,
|
$title, undef,
|
# 'open',
|
# 'open',
|
'select-folder',
|
'select-folder',
|
'gtk-cancel' => 'cancel',
|
'gtk-cancel' => 'cancel',
|
'gtk-ok' => 'ok',
|
'gtk-ok' => 'ok',
|
);
|
);
|
|
|
|
|
if ( "ok" eq $dialog->run ) {
|
if ( "ok" eq $dialog->run ) {
|
$file = $dialog->get_filename;
|
$file = $dialog->get_filename;
|
$$entry_ref->set_text($file);
|
$$entry_ref->set_text($file);
|
$object->object_add_attribute($attribute1,$attribute2,$file);
|
$object->object_add_attribute($attribute1,$attribute2,$file);
|
set_gui_status($object,$status,$timeout) if(defined $status);
|
set_gui_status($object,$status,$timeout) if(defined $status);
|
#check_input_file($file,$socgen,$soc_state,$info);
|
#check_input_file($file,$socgen,$soc_state,$info);
|
#print "file = $file\n";
|
#print "file = $file\n";
|
}
|
}
|
$dialog->destroy;
|
$dialog->destroy;
|
|
|
|
|
|
|
} , \$entry);
|
} , \$entry);
|
|
|
return $browse;
|
return $browse;
|
|
|
}
|
}
|
|
|
|
sub remove_project_dir_from_addr{
|
|
my $file=shift;
|
|
my $dir = Cwd::getcwd();
|
|
my $project_dir = abs_path("$dir/../../"); #mpsoc directory address
|
|
$file =~ s/$project_dir//;
|
|
return $file;
|
|
}
|
|
|
|
sub add_project_dir_to_addr{
|
|
my $file=shift;
|
|
my $dir = Cwd::getcwd();
|
|
my $project_dir = abs_path("$dir/../../"); #mpsoc directory address
|
|
return $file if(-f $file );
|
|
return "$project_dir/$file";
|
|
|
|
}
|
|
|
sub get_file_name {
|
sub get_file_name {
|
my ($object,$title,$entry,$attribute1,$attribute2,$extension,$lable,$open_in)= @_;
|
my ($object,$title,$entry,$attribute1,$attribute2,$extension,$lable,$open_in)= @_;
|
my $browse= def_image_button("icons/browse.png");
|
my $browse= def_image_button("icons/browse.png");
|
my $dir = Cwd::getcwd();
|
|
my $project_dir = abs_path("$dir/../../"); #mpsoc directory address
|
|
|
|
$browse->signal_connect("clicked"=> sub{
|
$browse->signal_connect("clicked"=> sub{
|
my $entry_ref=$_[1];
|
my $entry_ref=$_[1];
|
my $file;
|
my $file;
|
$title ='select directory' if(!defined $title);
|
$title ='select directory' if(!defined $title);
|
my $dialog = Gtk2::FileChooserDialog->new(
|
my $dialog = Gtk2::FileChooserDialog->new(
|
'Select a File', undef,
|
'Select a File', undef,
|
'open',
|
'open',
|
'gtk-cancel' => 'cancel',
|
'gtk-cancel' => 'cancel',
|
'gtk-ok' => 'ok',
|
'gtk-ok' => 'ok',
|
);
|
);
|
if(defined $extension){
|
if(defined $extension){
|
my $filter = Gtk2::FileFilter->new();
|
my $filter = Gtk2::FileFilter->new();
|
$filter->set_name($extension);
|
$filter->set_name($extension);
|
$filter->add_pattern("*.$extension");
|
$filter->add_pattern("*.$extension");
|
$dialog->add_filter ($filter);
|
$dialog->add_filter ($filter);
|
}
|
}
|
if(defined $open_in){
|
if(defined $open_in){
|
$dialog->set_current_folder ($open_in);
|
$dialog->set_current_folder ($open_in);
|
# print "$open_in\n";
|
# print "$open_in\n";
|
|
|
}
|
}
|
|
|
if ( "ok" eq $dialog->run ) {
|
if ( "ok" eq $dialog->run ) {
|
$file = $dialog->get_filename;
|
$file = $dialog->get_filename;
|
#remove $project_dir form beginig of each file
|
#remove $project_dir form beginig of each file
|
$file =~ s/$project_dir//;
|
$file =remove_project_dir_from_addr($file);
|
$$entry_ref->set_text($file);
|
$$entry_ref->set_text($file);
|
$object->object_add_attribute($attribute1,$attribute2,$file) if(defined $object);
|
$object->object_add_attribute($attribute1,$attribute2,$file) if(defined $object);
|
my ($name,$path,$suffix) = fileparse("$file",qr"\..[^.]*$");
|
my ($name,$path,$suffix) = fileparse("$file",qr"\..[^.]*$");
|
if(defined $lable){
|
if(defined $lable){
|
$lable->set_markup("<span foreground= 'black' ><b>$name$suffix</b></span>");
|
$lable->set_markup("<span foreground= 'black' ><b>$name$suffix</b></span>");
|
$lable->show;
|
$lable->show;
|
}
|
}
|
|
|
#check_input_file($file,$socgen,$soc_state,$info);
|
#check_input_file($file,$socgen,$soc_state,$info);
|
#print "file = $file\n";
|
#print "file = $file\n";
|
}
|
}
|
$dialog->destroy;
|
$dialog->destroy;
|
|
|
|
|
|
|
} , \$entry);
|
} , \$entry);
|
|
|
return $browse;
|
return $browse;
|
|
|
}
|
}
|
|
|
|
|
#################
|
#################
|
# widget update object
|
# widget update object
|
#################
|
#################
|
|
|
sub gen_entry_object {
|
sub gen_entry_object {
|
my ($object,$attribute1,$attribute2,$default,$status,$timeout)=@_;
|
my ($object,$attribute1,$attribute2,$default,$status,$timeout)=@_;
|
my $old=$object->object_get_attribute($attribute1,$attribute2);
|
my $old=$object->object_get_attribute($attribute1,$attribute2);
|
my $widget;
|
my $widget;
|
if(defined $old ){
|
if(defined $old ){
|
$widget=gen_entry($old);
|
$widget=gen_entry($old);
|
}
|
}
|
else
|
else
|
{
|
{
|
$widget=gen_entry($default);
|
$widget=gen_entry($default);
|
$object->object_add_attribute($attribute1,$attribute2,$default);
|
$object->object_add_attribute($attribute1,$attribute2,$default);
|
}
|
}
|
$widget-> signal_connect("changed" => sub{
|
$widget-> signal_connect("changed" => sub{
|
my $new_param_value=$widget->get_text();
|
my $new_param_value=$widget->get_text();
|
$object->object_add_attribute($attribute1,$attribute2,$new_param_value);
|
$object->object_add_attribute($attribute1,$attribute2,$new_param_value);
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
});
|
});
|
return $widget;
|
return $widget;
|
}
|
}
|
|
|
|
|
sub gen_combobox_object {
|
sub gen_combobox_object {
|
my ($object,$attribute1,$attribute2,$content,$default,$status,$timeout)=@_;
|
my ($object,$attribute1,$attribute2,$content,$default,$status,$timeout)=@_;
|
my @combo_list=split(",",$content);
|
my @combo_list=split(",",$content);
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
my $pos;
|
my $pos;
|
$pos=get_pos($value, @combo_list) if (defined $value);
|
$pos=get_pos($value, @combo_list) if (defined $value);
|
if(!defined $pos && defined $default){
|
if(!defined $pos && defined $default){
|
$object->object_add_attribute($attribute1,$attribute2,$default);
|
$object->object_add_attribute($attribute1,$attribute2,$default);
|
$pos=get_item_pos($default, @combo_list);
|
$pos=get_item_pos($default, @combo_list);
|
}
|
}
|
#print " my $pos=get_item_pos($value, @combo_list);\n";
|
#print " my $pos=get_item_pos($value, @combo_list);\n";
|
my $widget=gen_combo(\@combo_list, $pos);
|
my $widget=gen_combo(\@combo_list, $pos);
|
$widget-> signal_connect("changed" => sub{
|
$widget-> signal_connect("changed" => sub{
|
my $new_param_value=$widget->get_active_text();
|
my $new_param_value=$widget->get_active_text();
|
$object->object_add_attribute($attribute1,$attribute2,$new_param_value);
|
$object->object_add_attribute($attribute1,$attribute2,$new_param_value);
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
});
|
});
|
return $widget;
|
return $widget;
|
|
|
|
|
}
|
}
|
|
|
|
|
sub gen_comboentry_object {
|
sub gen_comboentry_object {
|
my ($object,$attribute1,$attribute2,$content,$default,$status,$timeout)=@_;
|
my ($object,$attribute1,$attribute2,$content,$default,$status,$timeout)=@_;
|
my @combo_list=split(",",$content);
|
my @combo_list=split(",",$content);
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
my $pos;
|
my $pos;
|
$pos=get_pos($value, @combo_list) if (defined $value);
|
$pos=get_pos($value, @combo_list) if (defined $value);
|
if(!defined $pos && defined $default){
|
if(!defined $pos && defined $default){
|
$object->object_add_attribute($attribute1,$attribute2,$default);
|
$object->object_add_attribute($attribute1,$attribute2,$default);
|
$pos=get_item_pos($default, @combo_list);
|
$pos=get_item_pos($default, @combo_list);
|
}
|
}
|
#print " my $pos=get_item_pos($value, @combo_list);\n";
|
#print " my $pos=get_item_pos($value, @combo_list);\n";
|
my $widget=gen_combo_entry(\@combo_list, $pos);
|
my $widget=gen_combo_entry(\@combo_list, $pos);
|
($widget->child)->signal_connect('changed' => sub {
|
($widget->child)->signal_connect('changed' => sub {
|
my ($entry) = @_;
|
my ($entry) = @_;
|
my $new_param_value=$entry->get_text();
|
my $new_param_value=$entry->get_text();
|
$object->object_add_attribute($attribute1,$attribute2,$new_param_value);
|
$object->object_add_attribute($attribute1,$attribute2,$new_param_value);
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
});
|
});
|
return $widget;
|
return $widget;
|
|
|
}
|
}
|
|
|
|
|
|
|
sub gen_spin_object {
|
sub gen_spin_object {
|
my ($object,$attribute1,$attribute2,$content, $default,$status,$timeout)=@_;
|
my ($object,$attribute1,$attribute2,$content, $default,$status,$timeout)=@_;
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
my ($min,$max,$step)=split(",",$content);
|
my ($min,$max,$step)=split(",",$content);
|
if(!defined $value){
|
if(!defined $value){
|
$value=$default;
|
$value=$default;
|
$object->object_add_attribute($attribute1,$attribute2,$value);
|
$object->object_add_attribute($attribute1,$attribute2,$value);
|
}
|
}
|
$value=~ s/\D//g;
|
|
$min=~ s/\D//g;
|
$value=~ s/[^0-9.]//g;
|
$max=~ s/\D//g;
|
$min=~ s/[^0-9.]//g;
|
$step=~ s/\D//g;
|
$max=~ s/[^0-9.]//g;
|
|
$step=~ s/[^0-9.]//g;
|
|
|
|
|
my $widget=gen_spin($min,$max,$step);
|
my $widget=gen_spin($min,$max,$step);
|
$widget->set_value($value);
|
$widget->set_value($value);
|
$widget-> signal_connect("value_changed" => sub{
|
$widget-> signal_connect("value_changed" => sub{
|
my $new_param_value=$widget->get_value_as_int();
|
my $new_param_value=$widget->get_value();
|
$object->object_add_attribute($attribute1,$attribute2,$new_param_value);
|
$object->object_add_attribute($attribute1,$attribute2,$new_param_value);
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
});
|
});
|
return $widget;
|
return $widget;
|
}
|
}
|
|
|
|
|
sub gen_check_box_object_array {
|
sub gen_check_box_object_array {
|
my ($object,$attribute1,$attribute2,$content,$default,$status,$timeout)=@_;
|
my ($object,$attribute1,$attribute2,$content,$default,$status,$timeout)=@_;
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
$value = $default if (!defined $value);
|
$value = $default if (!defined $value);
|
my $widget = def_hbox(FALSE,0);
|
my $widget = def_hbox(FALSE,0);
|
my @check;
|
my @check;
|
for (my $i=0;$i<$content;$i++){
|
for (my $i=0;$i<$content;$i++){
|
$check[$i]= Gtk2::CheckButton->new;
|
$check[$i]= Gtk2::CheckButton->new;
|
}
|
}
|
for (my $i=0;$i<$content;$i++){
|
for (my $i=0;$i<$content;$i++){
|
$widget->pack_end( $check[$i], FALSE, FALSE, 0);
|
$widget->pack_end( $check[$i], FALSE, FALSE, 0);
|
|
|
my @chars = split("",$value);
|
my @chars = split("",$value);
|
#check if saved value match the size of check box
|
#check if saved value match the size of check box
|
if($chars[0] ne $content ) {
|
if($chars[0] ne $content ) {
|
$object->object_add_attribute($attribute1,$attribute2,$default);
|
$object->object_add_attribute($attribute1,$attribute2,$default);
|
$value=$default;
|
$value=$default;
|
@chars = split("",$value);
|
@chars = split("",$value);
|
}
|
}
|
#set initial value
|
#set initial value
|
|
|
#print "\@chars=@chars\n";
|
#print "\@chars=@chars\n";
|
for (my $i=0;$i<$content;$i++){
|
for (my $i=0;$i<$content;$i++){
|
my $loc= (scalar @chars) -($i+1);
|
my $loc= (scalar @chars) -($i+1);
|
if( $chars[$loc] eq '1') {$check[$i]->set_active(TRUE);}
|
if( $chars[$loc] eq '1') {$check[$i]->set_active(TRUE);}
|
else {$check[$i]->set_active(FALSE);}
|
else {$check[$i]->set_active(FALSE);}
|
}
|
}
|
|
|
|
|
#get new value
|
#get new value
|
$check[$i]-> signal_connect("toggled" => sub{
|
$check[$i]-> signal_connect("toggled" => sub{
|
my $new_val="$content\'b";
|
my $new_val="$content\'b";
|
|
|
for (my $i=$content-1; $i >= 0; $i--){
|
for (my $i=$content-1; $i >= 0; $i--){
|
if($check[$i]->get_active()) {$new_val="${new_val}1" ;}
|
if($check[$i]->get_active()) {$new_val="${new_val}1" ;}
|
else {$new_val="${new_val}0" ;}
|
else {$new_val="${new_val}0" ;}
|
}
|
}
|
$object->object_add_attribute($attribute1,$attribute2,$new_val);
|
$object->object_add_attribute($attribute1,$attribute2,$new_val);
|
#print "\$new_val=$new_val\n";
|
#print "\$new_val=$new_val\n";
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
});
|
});
|
}
|
}
|
return $widget;
|
return $widget;
|
|
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
sub gen_check_box_object {
|
sub gen_check_box_object {
|
my ($object,$attribute1,$attribute2,$default,$status,$timeout)=@_;
|
my ($object,$attribute1,$attribute2,$default,$status,$timeout)=@_;
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
if (!defined $value){
|
if (!defined $value){
|
#set initial value
|
#set initial value
|
$object->object_add_attribute($attribute1,$attribute2,$default);
|
$object->object_add_attribute($attribute1,$attribute2,$default);
|
$value = $default
|
$value = $default
|
}
|
}
|
my $widget = Gtk2::CheckButton->new;
|
my $widget = Gtk2::CheckButton->new;
|
if($value == 1) {$widget->set_active(TRUE);}
|
if($value == 1) {$widget->set_active(TRUE);}
|
else {$widget->set_active(FALSE);}
|
else {$widget->set_active(FALSE);}
|
|
|
#get new value
|
#get new value
|
$widget-> signal_connect("toggled" => sub{
|
$widget-> signal_connect("toggled" => sub{
|
my $new_val;
|
my $new_val;
|
if($widget->get_active()) {$new_val=1;}
|
if($widget->get_active()) {$new_val=1;}
|
else {$new_val=0;}
|
else {$new_val=0;}
|
$object->object_add_attribute($attribute1,$attribute2,$new_val);
|
$object->object_add_attribute($attribute1,$attribute2,$new_val);
|
#print "\$new_val=$new_val\n";
|
#print "\$new_val=$new_val\n";
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
});
|
});
|
|
|
return $widget;
|
return $widget;
|
|
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
sub get_dir_in_object {
|
sub get_dir_in_object {
|
my ($object,$attribute1,$attribute2,$content,$status,$timeout)=@_;
|
my ($object,$attribute1,$attribute2,$content,$status,$timeout,$default)=@_;
|
my $widget = def_hbox(FALSE,0);
|
my $widget = def_hbox(FALSE,0);
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
|
$object->object_add_attribute($attribute1,$attribute2, $default) if (!defined $value );
|
|
$value = $default if (!defined $value );
|
my $entry=gen_entry($value);
|
my $entry=gen_entry($value);
|
$entry-> signal_connect("changed" => sub{
|
$entry-> signal_connect("changed" => sub{
|
my $new_param_value=$entry->get_text();
|
my $new_param_value=$entry->get_text();
|
$object->object_add_attribute($attribute1,$attribute2,$new_param_value);
|
$object->object_add_attribute($attribute1,$attribute2,$new_param_value);
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
});
|
});
|
my $browse= get_directory_name($object,undef,$entry,$attribute1,$attribute2,$status,$timeout);
|
my $browse= get_directory_name($object,undef,$entry,$attribute1,$attribute2,$status,$timeout);
|
$widget->pack_start( $entry, FALSE, FALSE, 0);
|
$widget->pack_start( $entry, FALSE, FALSE, 0);
|
$widget->pack_start( $browse, FALSE, FALSE, 0);
|
$widget->pack_start( $browse, FALSE, FALSE, 0);
|
return $widget;
|
return $widget;
|
}
|
}
|
|
|
|
|
|
|
|
|
sub get_file_name_object {
|
sub get_file_name_object {
|
my ($object,$attribute1,$attribute2,$extension,$open_in)=@_;
|
my ($object,$attribute1,$attribute2,$extension,$open_in)=@_;
|
my $widget = def_hbox(FALSE,0);
|
my $widget = def_hbox(FALSE,0);
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
my $lable;
|
my $lable;
|
if(defined $value){
|
if(defined $value){
|
my ($name,$path,$suffix) = fileparse("$value",qr"\..[^.]*$");
|
my ($name,$path,$suffix) = fileparse("$value",qr"\..[^.]*$");
|
$lable=gen_label_in_center($name.$suffix);
|
$lable=gen_label_in_center($name.$suffix);
|
|
|
} else {
|
} else {
|
$lable=gen_label_in_center("Selecet a file");
|
$lable=gen_label_in_center("Selecet a file");
|
$lable->set_markup("<span foreground= 'red' ><b>No file has been selected yet</b></span>");
|
$lable->set_markup("<span foreground= 'red' ><b>No file has been selected yet</b></span>");
|
}
|
}
|
my $entry=gen_entry();
|
my $entry=gen_entry();
|
my $browse= get_file_name($object,undef,$entry,$attribute1,$attribute2,$extension,$lable,$open_in);
|
my $browse= get_file_name($object,undef,$entry,$attribute1,$attribute2,$extension,$lable,$open_in);
|
$widget->pack_start( $lable, FALSE, FALSE, 0);
|
$widget->pack_start( $lable, FALSE, FALSE, 0);
|
$widget->pack_start( $browse, FALSE, FALSE, 0);
|
$widget->pack_start( $browse, FALSE, FALSE, 0);
|
return $widget;
|
return $widget;
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub add_param_widget {
|
|
my ($mpsoc,$name,$param, $default,$type,$content,$info, $table,$row,$column,$show,$attribut1,$ref_delay,$new_status,$loc)=@_;
|
|
my $label;
|
|
$label =gen_label_in_left(" $name") if(defined $name);
|
|
my $widget;
|
|
my $value=$mpsoc->object_get_attribute($attribut1,$param);
|
|
if(! defined $value) {
|
|
$mpsoc->object_add_attribute($attribut1,$param,$default);
|
|
$mpsoc->object_add_attribute_order($attribut1,$param);
|
|
$value=$default;
|
|
}
|
|
if(! defined $new_status){
|
|
$new_status='ref';
|
|
}
|
|
if ($type eq "Entry"){
|
|
$widget=gen_entry($value);
|
|
$widget-> signal_connect("changed" => sub{
|
|
my $new_param_value=$widget->get_text();
|
|
$mpsoc->object_add_attribute($attribut1,$param,$new_param_value);
|
|
set_gui_status($mpsoc,$new_status,$ref_delay) if(defined $ref_delay);
|
|
|
|
|
|
});
|
|
|
|
|
|
}
|
|
elsif ($type eq "Combo-box"){
|
|
my @combo_list=split(",",$content);
|
|
my $pos=get_pos($value, @combo_list) if(defined $value);
|
|
if(!defined $pos){
|
|
$mpsoc->object_add_attribute($attribut1,$param,$default);
|
|
$pos=get_item_pos($default, @combo_list) if (defined $default);
|
|
|
|
}
|
|
#print " my $pos=get_item_pos($value, @combo_list);\n";
|
|
$widget=gen_combo(\@combo_list, $pos);
|
|
$widget-> signal_connect("changed" => sub{
|
|
my $new_param_value=$widget->get_active_text();
|
|
$mpsoc->object_add_attribute($attribut1,$param,$new_param_value);
|
|
set_gui_status($mpsoc,$new_status,$ref_delay) if(defined $ref_delay);
|
|
|
|
|
|
});
|
|
|
|
}
|
|
elsif ($type eq "Spin-button"){
|
|
my ($min,$max,$step)=split(",",$content);
|
|
$value=~ s/\D//g;
|
|
$min=~ s/\D//g;
|
|
$max=~ s/\D//g;
|
|
$step=~ s/\D//g;
|
|
$widget=gen_spin($min,$max,$step);
|
|
$widget->set_value($value);
|
|
$widget-> signal_connect("value_changed" => sub{
|
|
my $new_param_value=$widget->get_value_as_int();
|
|
$mpsoc->object_add_attribute($attribut1,$param,$new_param_value);
|
|
set_gui_status($mpsoc,$new_status,$ref_delay) if(defined $ref_delay);
|
|
|
|
});
|
|
|
|
# $box=def_label_spin_help_box ($param,$info, $value,$min,$max,$step, 2);
|
|
}
|
|
|
|
elsif ( $type eq "Check-box"){
|
|
$widget = def_hbox(FALSE,0);
|
|
my @check;
|
|
for (my $i=0;$i<$content;$i++){
|
|
$check[$i]= Gtk2::CheckButton->new;
|
|
}
|
|
for (my $i=0;$i<$content;$i++){
|
|
$widget->pack_end( $check[$i], FALSE, FALSE, 0);
|
|
|
|
my @chars = split("",$value);
|
|
#check if saved value match the size of check box
|
|
if($chars[0] ne $content ) {
|
|
$mpsoc->object_add_attribute($attribut1,$param,$default);
|
|
$value=$default;
|
|
@chars = split("",$value);
|
|
}
|
|
#set initial value
|
|
|
|
#print "\@chars=@chars\n";
|
|
for (my $i=0;$i<$content;$i++){
|
|
my $loc= (scalar @chars) -($i+1);
|
|
if( $chars[$loc] eq '1') {$check[$i]->set_active(TRUE);}
|
|
else {$check[$i]->set_active(FALSE);}
|
|
}
|
|
|
|
|
|
#get new value
|
|
$check[$i]-> signal_connect("toggled" => sub{
|
|
my $new_val="$content\'b";
|
|
|
|
for (my $i=$content-1; $i >= 0; $i--){
|
|
if($check[$i]->get_active()) {$new_val="${new_val}1" ;}
|
|
else {$new_val="${new_val}0" ;}
|
|
}
|
|
$mpsoc->object_add_attribute($attribut1,$param,$new_val);
|
|
#print "\$new_val=$new_val\n";
|
|
set_gui_status($mpsoc,$new_status,$ref_delay) if(defined $ref_delay);
|
|
});
|
|
}
|
|
|
|
|
|
|
|
|
|
}
|
|
elsif ( $type eq "DIR_path"){
|
|
$widget =get_dir_in_object ($mpsoc,$attribut1,$param,$value,'ref',10);
|
|
set_gui_status($mpsoc,$new_status,$ref_delay) if(defined $ref_delay);
|
|
}
|
|
elsif ( $type eq "FILE_path"){ # use $content as extention
|
|
$widget =get_file_name_object ($mpsoc,$attribut1,$param,$content,undef);
|
|
set_gui_status($mpsoc,$new_status,$ref_delay) if(defined $ref_delay);
|
|
}
|
|
|
|
else {
|
|
$widget =gen_label_in_left("unsuported widget type!");
|
|
}
|
|
|
|
my $inf_bt= (defined $info)? gen_button_message ($info,"icons/help.png"):gen_label_in_left(" ");
|
|
if($show==1){
|
|
attach_widget_to_table ($table,$row,$label,$inf_bt,$widget,$column);
|
|
if ($loc eq "vertical"){
|
|
#print "$loc\n";
|
|
$row ++;}
|
|
else {
|
|
$column+=4;
|
|
}
|
|
}
|
|
return ($row,$column);
|
|
}
|
|
|
|
|
|
|
|
|
################
|
################
|
# ADD info and label to widget
|
# ADD info and label to widget
|
################
|
################
|
|
|
|
|
sub labele_widget_info{
|
sub labele_widget_info{
|
my ($label_name,$widget,$info)=@_;
|
my ($label_name,$widget,$info)=@_;
|
my $box = def_hbox(FALSE,0);
|
my $box = def_hbox(FALSE,0);
|
#label
|
#label
|
if(defined $label_name){
|
if(defined $label_name){
|
my $label= gen_label_in_left($label_name);
|
my $label= gen_label_in_left($label_name);
|
$box->pack_start( $label, FALSE, FALSE, 3);
|
$box->pack_start( $label, FALSE, FALSE, 3);
|
}
|
}
|
$box->pack_start( $widget, FALSE, FALSE, 3);
|
$box->pack_start( $widget, FALSE, FALSE, 3);
|
#info
|
#info
|
if(defined $info){
|
if(defined $info){
|
my $button=def_image_button("icons/help.png");
|
my $button=def_image_button("icons/help.png");
|
$button->signal_connect("clicked" => sub {message_dialog($info);});
|
$button->signal_connect("clicked" => sub {message_dialog($info);});
|
$box->pack_start( $button, FALSE, FALSE, 3);
|
$box->pack_start( $button, FALSE, FALSE, 3);
|
}
|
}
|
$box->show_all;
|
$box->show_all;
|
return $box;
|
return $box;
|
}
|
}
|
|
|
|
|
|
|
|
|
################
|
################
|
# general
|
# general
|
#################
|
#################
|
|
|
|
|
|
|
|
|
sub trim { my $s = shift; $s=~s/[\n]//gs; return $s };
|
sub trim { my $s = shift; $s=~s/[\n]//gs; return $s };
|
|
|
sub remove_all_white_spaces($)
|
sub remove_all_white_spaces($)
|
{
|
{
|
my $string = shift;
|
my $string = shift;
|
$string =~ s/\s+//g;
|
$string =~ s/\s+//g;
|
return $string;
|
return $string;
|
}
|
}
|
|
|
|
|
|
|
|
|
sub get_scolar_pos{
|
sub get_scolar_pos{
|
my ($item,@list)=@_;
|
my ($item,@list)=@_;
|
my $pos;
|
my $pos;
|
my $i=0;
|
my $i=0;
|
foreach my $c (@list)
|
foreach my $c (@list)
|
{
|
{
|
if( $c eq $item) {$pos=$i}
|
if( $c eq $item) {$pos=$i}
|
$i++;
|
$i++;
|
}
|
}
|
return $pos;
|
return $pos;
|
}
|
}
|
|
|
sub remove_scolar_from_array{
|
sub remove_scolar_from_array{
|
my ($array_ref,$item)=@_;
|
my ($array_ref,$item)=@_;
|
my @array=@{$array_ref};
|
my @array=@{$array_ref};
|
my @new;
|
my @new;
|
foreach my $p (@array){
|
foreach my $p (@array){
|
if($p ne $item ){
|
if($p ne $item ){
|
push(@new,$p);
|
push(@new,$p);
|
}
|
}
|
}
|
}
|
return @new;
|
return @new;
|
}
|
}
|
|
|
sub replace_in_array{
|
sub replace_in_array{
|
my ($array_ref,$item1,$item2)=@_;
|
my ($array_ref,$item1,$item2)=@_;
|
my @array=@{$array_ref};
|
my @array=@{$array_ref};
|
my @new;
|
my @new;
|
foreach my $p (@array){
|
foreach my $p (@array){
|
if($p eq $item1 ){
|
if($p eq $item1 ){
|
push(@new,$item2);
|
push(@new,$item2);
|
}else{
|
}else{
|
push(@new,$p);
|
push(@new,$p);
|
}
|
}
|
}
|
}
|
return @new;
|
return @new;
|
}
|
}
|
|
|
|
|
|
|
# return an array of common elemnts between two input arays
|
# return an array of common elemnts between two input arays
|
sub get_common_array{
|
sub get_common_array{
|
my ($a_ref,$b_ref)=@_;
|
my ($a_ref,$b_ref)=@_;
|
my @A=@{$a_ref};
|
my @A=@{$a_ref};
|
my @B=@{$b_ref};
|
my @B=@{$b_ref};
|
my @C;
|
my @C;
|
foreach my $p (@A){
|
foreach my $p (@A){
|
if( grep (/^$p$/,@B)){push(@C,$p)};
|
if( grep (/^\Q$p\E$/,@B)){push(@C,$p)};
|
}
|
}
|
return @C;
|
return @C;
|
}
|
}
|
|
|
#a-b
|
#a-b
|
sub get_diff_array{
|
sub get_diff_array{
|
my ($a_ref,$b_ref)=@_;
|
my ($a_ref,$b_ref)=@_;
|
my @A=@{$a_ref};
|
my @A=@{$a_ref};
|
my @B=@{$b_ref};
|
my @B=@{$b_ref};
|
my @C;
|
my @C;
|
foreach my $p (@A){
|
foreach my $p (@A){
|
if( !grep (/^$p$/,@B)){push(@C,$p)};
|
if( !grep (/^\Q$p\E$/,@B)){push(@C,$p)};
|
}
|
}
|
return @C;
|
return @C;
|
|
|
}
|
}
|
|
|
|
|
|
|
sub compress_nums{
|
sub compress_nums{
|
my @nums=@_;
|
my @nums=@_;
|
my @f=sort { $a <=> $b } @nums;
|
my @f=sort { $a <=> $b } @nums;
|
my $s;
|
my $s;
|
my $ls;
|
my $ls;
|
my $range=0;
|
my $range=0;
|
my $x;
|
my $x;
|
|
|
|
|
foreach my $p (@f){
|
foreach my $p (@f){
|
if(!defined $x) {
|
if(!defined $x) {
|
$s="$p";
|
$s="$p";
|
$ls=$p;
|
$ls=$p;
|
|
|
}
|
}
|
else{
|
else{
|
if($p-$x>1){ #gap exist
|
if($p-$x>1){ #gap exist
|
if( $range){
|
if( $range){
|
$s=($x-$ls>1 )? "$s:$x,$p": "$s,$x,$p";
|
$s=($x-$ls>1 )? "$s:$x,$p": "$s,$x,$p";
|
$ls=$p;
|
$ls=$p;
|
$range=0;
|
$range=0;
|
}else{
|
}else{
|
$s= "$s,$p";
|
$s= "$s,$p";
|
$ls=$p;
|
$ls=$p;
|
|
|
}
|
}
|
|
|
}else {$range=1;}
|
}else {$range=1;}
|
|
|
|
|
|
|
}
|
}
|
|
|
$x=$p
|
$x=$p
|
}
|
}
|
if($range==1){ $s= ($x-$ls>1 )? "$s:$x": "$s,$x";}
|
if($range==1){ $s= ($x-$ls>1 )? "$s:$x": "$s,$x";}
|
#update $s($ls,$hs);
|
#update $s($ls,$hs);
|
|
|
return $s;
|
return $s;
|
|
|
}
|
}
|
|
|
|
|
|
|
sub metric_conversion{
|
sub metric_conversion{
|
my $size=shift;
|
my $size=shift;
|
my $size_text= $size==0 ? 'Error':
|
my $size_text= $size==0 ? 'Error':
|
$size<(1 << 10)? $size:
|
$size<(1 << 10)? $size:
|
$size<(1 << 20)? join (' ', ($size>>10,"K")) :
|
$size<(1 << 20)? join (' ', ($size>>10,"K")) :
|
$size<(1 << 30)? join (' ', ($size>>20,"M")) :
|
$size<(1 << 30)? join (' ', ($size>>20,"M")) :
|
join (' ', ($size>>30,"G")) ;
|
join (' ', ($size>>30,"G")) ;
|
return $size_text;
|
return $size_text;
|
}
|
}
|
|
|
|
|
|
|
sub check_verilog_identifier_syntax {
|
sub check_verilog_identifier_syntax {
|
my $in=shift;
|
my $in=shift;
|
my $error=0;
|
my $error=0;
|
my $message='';
|
my $message='';
|
# an Identifiers must begin with an alphabetic character or the underscore character
|
# an Identifiers must begin with an alphabetic character or the underscore character
|
if ($in =~ /^[0-9\$]/){
|
if ($in =~ /^[0-9\$]/){
|
return 'an Identifier must begin with an alphabetic character or the underscore character';
|
return 'an Identifier must begin with an alphabetic character or the underscore character';
|
}
|
}
|
|
|
|
|
# Identifiers may contain alphabetic characters, numeric characters, the underscore, and the dollar sign (a-z A-Z 0-9 _ $ )
|
# Identifiers may contain alphabetic characters, numeric characters, the underscore, and the dollar sign (a-z A-Z 0-9 _ $ )
|
if ($in =~ /[^a-zA-Z0-9_\$]+/){
|
if ($in =~ /[^a-zA-Z0-9_\$]+/){
|
print "use of illegal character after\n" ;
|
print "use of illegal character after\n" ;
|
my @w= split /([^a-zA-Z0-9_\$]+)/, $in;
|
my @w= split /([^a-zA-Z0-9_\$]+)/, $in;
|
return "Contain illegal character of \"$w[1]\". Identifiers may contain alphabetic characters, numeric characters, the underscore, and the dollar sign (a-z A-Z 0-9 _ \$ )\n";
|
return "Contain illegal character of \"$w[1]\". Identifiers may contain alphabetic characters, numeric characters, the underscore, and the dollar sign (a-z A-Z 0-9 _ \$ )\n";
|
|
|
}
|
}
|
|
|
|
|
# check Verilog reserved words
|
# check Verilog reserved words
|
my @keys = ("always","and","assign","automatic","begin","buf","bufif0","bufif1","case","casex","casez","cell","cmos","config","deassign","default","defparam","design","disable","edge","else","end","endcase","endconfig","endfunction","endgenerate","endmodule","endprimitive","endspecify","endtable","endtask","event","for","force","forever","fork","function","generate","genvar","highz0","highz1","if","ifnone","incdir","include","initial","inout","input","instance","integer","join","large","liblist","library","localparam","macromodule","medium","module","nand","negedge","nmos","nor","noshowcancelled","not","notif0","notif1","or","output","parameter","pmos","posedge","primitive","pull0","pull1","pulldown","pullup","pulsestyle_onevent","pulsestyle_ondetect","remos","real","realtime","reg","release","repeat","rnmos","rpmos","rtran","rtranif0","rtranif1","scalared","showcancelled","signed","small","specify","specparam","strong0","strong1","supply0","supply1","table","task","time","tran","tranif0","tranif1","tri","tri0","tri1","triand","trior","trireg","unsigned","use","vectored","wait","wand","weak0","weak1","while","wire","wor","xnor","xor");
|
my @keys = ("always","and","assign","automatic","begin","buf","bufif0","bufif1","case","casex","casez","cell","cmos","config","deassign","default","defparam","design","disable","edge","else","end","endcase","endconfig","endfunction","endgenerate","endmodule","endprimitive","endspecify","endtable","endtask","event","for","force","forever","fork","function","generate","genvar","highz0","highz1","if","ifnone","incdir","include","initial","inout","input","instance","integer","join","large","liblist","library","localparam","macromodule","medium","module","nand","negedge","nmos","nor","noshowcancelled","not","notif0","notif1","or","output","parameter","pmos","posedge","primitive","pull0","pull1","pulldown","pullup","pulsestyle_onevent","pulsestyle_ondetect","remos","real","realtime","reg","release","repeat","rnmos","rpmos","rtran","rtranif0","rtranif1","scalared","showcancelled","signed","small","specify","specparam","strong0","strong1","supply0","supply1","table","task","time","tran","tranif0","tranif1","tri","tri0","tri1","triand","trior","trireg","unsigned","use","vectored","wait","wand","weak0","weak1","while","wire","wor","xnor","xor");
|
if( grep (/^$in$/,@keys)){
|
if( grep (/^$in$/,@keys)){
|
return "$in is a Verlig reserved word.";
|
return "$in is a Verlig reserved word.";
|
}
|
}
|
return undef;
|
return undef;
|
|
|
}
|
}
|
|
|
|
|
|
sub capture_number_after {
|
|
my ($after,$text)=@_;
|
|
my @q =split (/$after/,$text);
|
|
#my $d=$q[1];
|
|
my @d = split (/[^0-9. ]/,$q[1]);
|
|
return $d[0];
|
|
|
|
}
|
|
|
|
sub capture_string_between {
|
|
my ($start,$text,$end)=@_;
|
|
my @q =split (/$start/,$text);
|
|
my @d = split (/$end/,$q[1]);
|
|
return $d[0];
|
|
}
|
|
|
|
|
1
|
1
|
|
|
