OpenCores
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 41

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

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 25 alirezamon 
 
7 
 
8 38 alirezamon 
 
9 16 alirezamon 
use Gtk2::Pango;
10 25 alirezamon 
#use Tk::Animation;
11 16 alirezamon 
 
12 38 alirezamon 
use String::Similarity;
13 
 
14 
 
15 
sub find_the_most_similar_position{
16 
        my ($item ,@list)=@_;
17 
        my $most_similar_pos=0;
18 
        my $lastsim=0;
19 
        my $i=0;
20 
        # convert item to lowercase
21 
        $item = lc $item;
22 
        foreach my $p(@list){
23 
                my $similarity= similarity $item, $p;
24 
                if ($similarity > $lastsim){
25 
                        $lastsim=$similarity;
26 
                        $most_similar_pos=$i;
27 
                }
28 
                $i++;
29 
        }
30 
        return $most_similar_pos;
31 
}
32 
 
33 16 alirezamon 
##############
34 
# combo box
35 
#############
36 
sub gen_combo{
37 
        my ($combo_list, $combo_active_pos)= @_;
38 
        my $combo = Gtk2::ComboBox->new_text;
39 
 
40 
        combo_set_names($combo,$combo_list);
41 25 alirezamon 
        $combo->set_active($combo_active_pos) if(defined $combo_active_pos);
42 16 alirezamon 
 
43 
        #my $font = Gtk2::Pango::FontDescription->from_string('Tahoma 5');
44 
        #$combo->modify_font($font);
45 
 
46 
 
47 
        return $combo;
48 
}
49 
 
50 
 
51 
sub combo_set_names {
52 
        my ( $combo, $list_ref ) = @_;
53 
        my @list=@{$list_ref};
54 
        #print "$list[0]\n";
55 
        for my $item (@list){$combo->append_text($item);}
56 
}
57 
 
58 
 
59 
sub gen_combo_help {
60 
        my ($help, @combo_list, $pos)= @_;
61 
        my $box = def_hbox(FALSE, 0);
62 
        my $combo= gen_combo(@combo_list, $pos);
63 
        my $button=def_image_button("icons/help.png");
64 
 
65 
        $button->signal_connect("clicked" => sub {message_dialog($help);});
66 
 
67 
        $box->pack_start( $combo, FALSE, FALSE, 3);
68 
        $box->pack_start( $button, FALSE, FALSE, 3);
69 
        $box->show_all;
70 
 
71 
        return ($box,$combo);
72 
}
73 
 
74 
 
75 
sub def_h_labeled_combo{
76 
                my ($label_name,$combo_list,$combo_active_pos)=@_;
77 
                my $box = def_hbox(TRUE,0);
78 
                my $label= gen_label_in_left($label_name);
79 
                my $combo= gen_combo($combo_list, $combo_active_pos);
80 
                $box->pack_start( $label, FALSE, FALSE, 3);
81 
                $box->pack_start( $combo, FALSE, TRUE, 3);
82 
                return ($box,$combo);
83 
}
84 
 
85 
sub def_h_labeled_combo_scaled{
86 
                my ($label_name,$combo_list,$combo_active_pos,$lable_w,$comb_w)=@_;
87 
                my $table= def_table(1,3,TRUE);
88 
                my $label= gen_label_in_left($label_name);
89 
                my $combo= gen_combo($combo_list, $combo_active_pos);
90 
                $table->attach_defaults ($label, 0, $lable_w, 0, 1);
91 
                $table->attach_defaults ($combo, 1, $lable_w+$comb_w, 0, 1);
92 
 
93 
 
94 
 
95 
 
96 
                return ($table,$combo);
97 
}
98 
 
99 
 
100 
##############
101 
# spin button
102 
#############
103 
sub gen_spin{
104 
        my ($min,$max,$step)= @_;
105 
        my $spin = Gtk2::SpinButton->new_with_range ($min, $max, $step);
106 
        return $spin;
107 
}
108 
 
109 
 
110 
 
111 
sub gen_spin_help {
112 
        my ($help, $min,$max,$step)= @_;
113 
        my $box = def_hbox(FALSE, 0);
114 
        my $spin= gen_spin($min,$max,$step);
115 
        my $button=def_image_button("icons/help.png");
116 
 
117 
        $button->signal_connect("clicked" => sub {message_dialog($help);});
118 
 
119 
        $box->pack_start( $spin, FALSE, FALSE, 3);
120 
        $box->pack_start( $button, FALSE, FALSE, 3);
121 
        $box->show_all;
122 
 
123 
        return ($box,$spin);
124 
}
125 
 
126 
 
127 
#############
128 
#  entry
129 
#############
130 
sub gen_entry{
131 
        my ($initial) = @_;
132 
        my $entry = Gtk2::Entry->new;
133 
        if(defined $initial){ $entry->set_text($initial)};
134 
        return $entry;
135 
}
136 
 
137 
 
138 
sub gen_entry_help{
139 
        my ($help, $init)= @_;
140 
        my $box = def_hbox(FALSE, 0);
141 
        my $entry= gen_entry ($init);
142 
        my $button=def_image_button("icons/help.png");
143 
 
144 
        $button->signal_connect("clicked" => sub {message_dialog($help);});
145 
 
146 
        $box->pack_start( $entry, FALSE, FALSE, 3);
147 
        $box->pack_start( $button, FALSE, FALSE, 3);
148 
        $box->show_all;
149 
 
150 
        return ($box,$entry);
151 
}
152 
 
153 
sub def_h_labeled_entry{
154 
        my ($label_name,$initial)=@_;
155 
        my $box = def_hbox(TRUE,0);
156 
        my $label= gen_label_in_left($label_name);
157 
        my $entry =gen_entry($initial);
158 
        $box->pack_start( $label, FALSE, FALSE, 3);
159 
        $box->pack_start( $entry, FALSE, FALSE, 3);
160 
        return ($box,$entry);
161 
 
162 24 alirezamon 
}
163 16 alirezamon 
 
164 24 alirezamon 
sub def_h_labeled_entry_help{
165 
        my ($help,$label_name,$initial)=@_;
166 
        my $box = def_hbox(TRUE,0);
167 
        my $label= gen_label_in_left($label_name);
168 
        my ($b,$entry) =gen_entry_help($help,$initial);
169 
        $box->pack_start( $label, FALSE, FALSE, 3);
170 
        $box->pack_start( $b, FALSE, FALSE, 3);
171 
        return ($box,$entry);
172 
 
173 
}
174 
 
175 17 alirezamon 
##############
176 
# ComboBoxEntry
177 
##############
178 16 alirezamon 
 
179 17 alirezamon 
sub gen_combo_entry{
180 25 alirezamon 
        my ($list_ref,$pos)=@_;
181 17 alirezamon 
        my @list=@{$list_ref};
182 
 
183 
        my $combo_box_entry = Gtk2::ComboBoxEntry->new_text;
184 
        foreach my $p (@list){
185 
                $combo_box_entry->append_text($p);
186 
        }
187 25 alirezamon 
        $pos=0 if(! defined $pos );
188 
        $combo_box_entry->set_active($pos);
189 17 alirezamon 
        return $combo_box_entry;
190 
}
191 
 
192 25 alirezamon 
 
193 
sub def_h_labeled_combo_entry_help{
194 
        my ($help,$label_name,$list_ref,$initial)=@_;
195 
        my $box = def_hbox(TRUE,0);
196 
        my $label= gen_label_in_left($list_ref);
197 
        my ($b,$entry) =gen_combo_entry($help,$initial);
198 
        $box->pack_start( $label, FALSE, FALSE, 3);
199 
        $box->pack_start( $b, FALSE, FALSE, 3);
200 
        return ($box,$entry);
201 
 
202 
}
203 
 
204 24 alirezamon 
###########
205 
#
206 
###########
207 
 
208 
sub def_h_labeled_checkbutton{
209 
        my ($label_name,$status)=@_;
210 
        my $box = def_hbox(TRUE,0);
211 
        my $label= gen_label_in_left($label_name);
212 
        my $check= Gtk2::CheckButton->new;
213 
        #if($status==1) $check->
214 
        $box->pack_start( $label, FALSE, FALSE, 3);
215 
        $box->pack_start( $check, FALSE, FALSE, 3);
216 
        return ($box,$check);
217 
 
218 
}
219 
 
220 
 
221 
 
222 
 
223 16 alirezamon 
#############
224 
#  label
225 
############
226 
 
227 
sub gen_label_in_left{
228 
        my ($data)=@_;
229 
        my $label   = Gtk2::Label->new($data);
230 
        $label->set_alignment( 0, 0.5 );
231 
        #my $font = Gtk2::Pango::FontDescription->from_string('Tahoma 5');
232 
        #$label->modify_font($font);
233 
        return $label;
234 
}
235 
 
236 
 
237 
sub gen_label_in_center{
238 
        my ($data)=@_;
239 
        my $label   = Gtk2::Label->new($data);
240 
        return $label;
241 
}
242 
 
243 
sub def_label{
244 
        my @data=@_;
245 
        my $label   = Gtk2::Label->new(@data);
246 
        $label->set_alignment( 0, 0.5 );
247 
        return $label;
248 
 
249 
}
250 
 
251 
 
252 
sub box_label{
253 
        my( $homogeneous, $spacing, $name)=@_;
254 
        my $box=def_hbox($homogeneous, $spacing);
255 
        my $label= def_label($name);
256 
        $box->pack_start( $label, FALSE, FALSE, 3);
257 
        return $box;
258 
}
259 
 
260 
 
261 
sub def_title_box{
262 
        my( $homogeneous, $spacing, @labels)=@_;
263 
        my $box=def_hbox($homogeneous, $spacing);
264 
        foreach my $label (@labels){
265 
                my $labelbox=box_label($homogeneous, $spacing, $label);
266 
                $box->pack_start( $labelbox, FALSE, FALSE, 3);
267 
 
268 
        }
269 
        return $box;
270 
}
271 
 
272 
 
273 
sub gen_label_help {
274 
        my ($help, $label_name)= @_;
275 
        my $box = def_hbox(FALSE, 0);
276 
        my $label= gen_label_in_left($label_name);
277 
        my $button=def_image_button("icons/help.png");
278 
 
279 
        $button->signal_connect("clicked" => sub {message_dialog($help);});
280 
 
281 
        $box->pack_start( $label, FALSE, FALSE, 0);
282 
        $box->pack_start( $button, FALSE, FALSE, 0);
283 
        $box->set_spacing (0);
284 
        $box->show_all;
285 
 
286 
        return $box;
287 
 
288 
 
289 
}
290 
 
291 
 
292 
 
293 
 
294 
##############
295 
# button
296 
#############
297 
 
298 
 
299 
sub button_box{
300 
# create a new button
301 
        my @label=@_;
302 
        my $button = Gtk2::Button->new_from_stock(@label);
303 
        my $box=def_hbox(TRUE,5);
304 
        $box->pack_start($button,   FALSE, FALSE,0);
305 
 
306 
        return ($box,$button);
307 
 
308 
}
309 
 
310 
 
311 34 alirezamon 
sub def_icon{
312 16 alirezamon 
        my $image_file=shift;
313 25 alirezamon 
        my $font_size=get_defualt_font_size();
314 16 alirezamon 
        my $size=($font_size==10)? 25:
315 
                     ($font_size==9 )? 22:
316 
                         ($font_size==8 )? 18:
317 
                         ($font_size==7 )? 15:12 ;
318 
        my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file_at_scale($image_file,$size,$size,FALSE);
319 
 
320 
 
321 
        my $image = Gtk2::Image->new_from_pixbuf($pixbuf);
322 
        return $image;
323 
 
324 
}
325 
 
326 
 
327 34 alirezamon 
sub open_image{
328 
        my ($image_file,$x,$y,$unit)=@_;
329 
        if(defined $unit){
330 
                my($width,$hight)=max_win_size();
331 
                if($unit eq 'percent'){
332 
                        $x= ($x * $width)/100;
333 
                        $y= ($y * $hight)/100;
334 
                } # else its pixels
335 
 
336 
        }
337 
        my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file_at_scale($image_file,$x,$y,TRUE);
338 
        my $image = Gtk2::Image->new_from_pixbuf($pixbuf);
339 
        return $image;
340 16 alirezamon 
 
341 34 alirezamon 
}
342 
 
343 
 
344 
 
345 16 alirezamon 
sub def_image_button{
346 25 alirezamon 
        my ($image_file, $label_text, $homogeneous)=@_;
347 16 alirezamon 
        # create box for image and label
348 25 alirezamon 
        $homogeneous = FALSE if(!defined $homogeneous);
349 
        my $box = def_hbox($homogeneous,0);
350 34 alirezamon 
        my $image = def_icon($image_file) if(-f $image_file);
351 16 alirezamon 
 
352 
 
353 
        # now on to the image stuff
354 
        #my $image = Gtk2::Image->new_from_file($image_file);
355 34 alirezamon 
        $box->pack_start($image, FALSE, FALSE, 0) if(-f $image_file);
356 16 alirezamon 
        $box->set_border_width(0);
357 
        $box->set_spacing (0);
358 
        # Create a label for the button
359 
        if(defined $label_text ) {
360 
                my $label = Gtk2::Label->new("  $label_text");
361 
                $box->pack_start($label, FALSE, FALSE, 0);
362 
        }
363 
 
364 
 
365 
        my $button = Gtk2::Button->new();
366 
        $button->add($box);
367 
        $button->set_border_width(0);
368 
        $button->show_all;
369 
        return $button;
370 
 
371 
}
372 
 
373 
 
374 
sub def_image_label{
375 
        my ($image_file, $label_text)=@_;
376 
        # create box for image and label
377 
        my $box = def_hbox(FALSE,1);
378 
        # now on to the image stuff
379 34 alirezamon 
        my $image = def_icon($image_file);
380 16 alirezamon 
        $box->pack_start($image, TRUE, FALSE, 0);
381 
        # Create a label for the button
382 
        if(defined $label_text ) {
383 
                my $label = Gtk2::Label->new($label_text);
384 
                $box->pack_start($label, TRUE, FALSE, 0);
385 
        }
386 
 
387 
        return $box;
388 
 
389 
}
390 
 
391 
 
392 
sub gen_button_message {
393 
        my ($help, $image_file,$label_name)= @_;
394 
        my $box = def_hbox(FALSE, 0);
395 
        my $label= gen_label_in_center($label_name) if(defined $label_name);
396 
        my $button=def_image_button($image_file);
397 
 
398 
        if(defined $help ){$button->signal_connect("clicked" => sub {message_dialog($help);});}
399 
 
400 
        $box->pack_start( $label, FALSE, FALSE, 0) if(defined $label_name);
401 
        $box->pack_start( $button, FALSE, FALSE, 0);
402 
        $box->set_border_width(0);
403 
        $box->set_spacing (0);
404 
        $box->show_all;
405 
 
406 
        return $box;
407 
 
408 
 
409 
}
410 
 
411 
 
412 
sub def_colored_button{
413 
        my ($label_text,$color_num)=@_;
414 
        # create box for image and label
415 
        my $box = def_hbox(FALSE,0);
416 25 alirezamon 
        my $font_size=get_defualt_font_size();
417 16 alirezamon 
        my $size=($font_size==10)? 25:
418 
                     ($font_size==9 )? 22:
419 
                         ($font_size==8 )? 18:
420 
                         ($font_size==7 )? 15:12 ;
421 
        $box->set_border_width(0);
422 
        $box->set_spacing (0);
423 
        # Create a label for the button
424 
        if(defined $label_text ) {
425 
                my $label = gen_label_in_center("$label_text");
426 
                $box->pack_start($label, TRUE, TRUE, 0);
427 
        }
428 
        my @clr_code=get_color($color_num);
429 
        my $color = Gtk2::Gdk::Color->new (@clr_code);
430 
 
431 
        my $button = Gtk2::Button->new();
432 
        $button->modify_bg('normal',$color);
433 
        $button->add($box);
434 
        $button->set_border_width(0);
435 
        $button->show_all;
436 
        return $button;
437 
 
438 
}
439 
 
440 
 
441 
 
442 
 
443 25 alirezamon 
sub show_gif{
444 16 alirezamon 
 
445 25 alirezamon 
        my $gif = shift;
446 
        #my $mw=def_popwin_size(400,200,'hey');
447 
        my $vbox = Gtk2::HBox->new (TRUE, 8);
448 
    my $filename;
449 
      eval {
450 
##          $filename = demo_find_file ("floppybuddy.gif");
451 
          $filename = main::demo_find_file ($gif);
452 
      };
453 
 
454 
 
455 
      my $image = Gtk2::Image->new_from_file ($gif);
456 
 
457 
     $vbox->set_border_width (4);
458 
     my   $align = Gtk2::Alignment->new (0.5, 0.5, 0, 0);
459 
 
460 
        my $frame = Gtk2::Frame->new;
461 
        $frame->set_shadow_type ('in');
462 16 alirezamon 
 
463 25 alirezamon 
 
464 
 
465 
 
466 
      # Animation
467 
     $frame->add ($image);
468 
      $align->add ($frame);
469 16 alirezamon 
 
470 25 alirezamon 
 
471 
 
472 
 
473 
     $vbox->pack_start ($align, FALSE, FALSE, 0);
474 
 
475 
      # $mw->add ($vbox);
476 
 
477 
 
478 
      # Progressive
479 
 
480 
 
481 
 
482 
 
483 
        #$mw->show_all();
484 
  return $vbox;
485 
 
486 
 
487 
 
488 
 
489 
}
490 
 
491 16 alirezamon 
############
492 
#       message_dialog
493 
############
494 
 
495 
sub message_dialog {
496 34 alirezamon 
  my ($message,$type)=@_;
497 
  $type = 'info' if (!defined $type);
498 16 alirezamon 
  my $window;
499 
  my $dialog = Gtk2::MessageDialog->new ($window,
500 
                                   [qw/modal destroy-with-parent/],
501 34 alirezamon 
                                   $type,
502 16 alirezamon 
                                   'ok',
503 34 alirezamon 
                                    $message);
504 16 alirezamon 
  $dialog->run;
505 
  $dialog->destroy;
506 
 
507 
}
508 
 
509 
 
510 38 alirezamon 
 
511 
sub set_tip{
512 
        my ($widget,$tip)=@_;
513 
        my $tooltips = Gtk2::Tooltips->new;
514 
        $tooltips->set_tip($widget,$tip);
515 
 
516 
 
517 
}
518 
 
519 
 
520 16 alirezamon 
############
521 
# window
522 
###########
523 
 
524 
sub def_win {
525 
        my @titel=shift;
526 
        my $window = Gtk2::Window->new('toplevel');
527 
        $window->set_title(@titel);
528 
        $window->set_position("center");
529 
        $window->set_default_size(100, 100);
530 
        $window->set_border_width(20);
531 
        $window->signal_connect (delete_event => sub { Gtk2->main_quit });
532 
        return $window;
533 
 
534 
}
535 
 
536 
 
537 
sub def_win_size {
538 
        my $x=shift;
539 
        my $y=shift;
540 
        my @titel=shift;
541 
        my $window = Gtk2::Window->new('toplevel');
542 
        $window->set_title(@titel);
543 
        $window->set_position("center");
544 
        $window->set_default_size($x, $y);
545 
        $window->set_border_width(20);
546 
        $window->signal_connect (delete_event => sub { Gtk2->main_quit });
547 
        return $window;
548 
 
549 
}
550 
 
551 
 
552 
sub def_popwin_size {
553 34 alirezamon 
        my ($x,$y,$titel,$unit)=@_;
554 
        if(defined $unit){
555 
                my($width,$hight)=max_win_size();
556 
                if($unit eq 'percent'){
557 
                        $x= ($x * $width)/100;
558 
                        $y= ($y * $hight)/100;
559 
                } # else its pixels
560 
 
561 
        }
562 16 alirezamon 
        #my $window = Gtk2::Window->new('popup');
563 
        my $window = Gtk2::Window->new('toplevel');
564 34 alirezamon 
        $window->set_title($titel);
565 16 alirezamon 
        $window->set_position("center");
566 
        $window->set_default_size($x, $y);
567 
        $window->set_border_width(20);
568 
        $window->signal_connect (delete_event => sub { $window->destroy });
569 
        return $window;
570 
 
571 
}
572 
 
573 
 
574 25 alirezamon 
 
575 
 
576 
 
577 16 alirezamon 
sub def_scrolled_window_box{
578 
 
579 
        my $window =  def_popwin_size(@_);
580 
        my $box=def_vbox(TRUE,5);
581 
        my $scrolled_window = new Gtk2::ScrolledWindow (undef, undef);
582 
        $scrolled_window->set_policy( "automatic", "automatic" );
583 
        $scrolled_window->add_with_viewport($box);
584 
        $window->add($scrolled_window);
585 
        $window->show_all;
586 
        $box->show_all;
587 
        return ($box,$window);
588 
 
589 
}
590 
 
591 
sub max_win_size{
592 
        my $screen =Gtk2::Gdk::Screen->get_default();
593 
        my $hight = $screen->get_height();
594 
        my $width = $screen->get_width();
595 
        return ($width,$hight);
596 
}
597 
 
598 
 
599 25 alirezamon 
sub get_defualt_font_size{
600 16 alirezamon 
        my($width,$hight)=max_win_size();
601 
        #print "($width,$hight)\n";
602 
        my $font_size=($width>=1600)? 10:
603 
                              ($width>=1400)? 9:
604 34 alirezamon 
                                  ($width>=1200)? 9:
605 16 alirezamon 
                                  ($width>=1000)? 7:6;
606 25 alirezamon 
        #print "$font_size\n";
607 16 alirezamon 
        return $font_size;
608 
}
609 
 
610 
 
611 25 alirezamon 
sub set_defualt_font_size{
612 
        my $font_size=get_defualt_font_size();
613 
 
614 16 alirezamon 
                Gtk2::Rc->parse_string(<<__);
615 
                        style "normal" {
616 25 alirezamon 
                                font_name ="Verdana $font_size"
617 16 alirezamon 
                        }
618 
                        widget "*" style "normal"
619 
__
620 
 
621 
}
622 
 
623 38 alirezamon 
sub gen_scr_win_with_adjst {
624 
        my ($self,$name)=@_;
625 
        my $scrolled_win = new Gtk2::ScrolledWindow (undef, undef);
626 
        $scrolled_win->set_policy( "automatic", "automatic" );
627 
        $scrolled_win->signal_connect("destroy"=> sub{
628 
                save_scrolled_win_adj($self,$scrolled_win, $name);
629 
 
630 
         });
631 
         my $adjast=0;
632 
         $scrolled_win->signal_connect("size-allocate"=> sub{
633 
                if($adjast==0){
634 
                        load_scrolled_win_adj($self,$scrolled_win, $name);
635 
                        $adjast=1;
636 
                }
637 
 
638 
         });
639 
        return $scrolled_win;
640 
}
641 16 alirezamon 
 
642 38 alirezamon 
 
643 
sub save_scrolled_win_adj {
644 
        my ($self,$scrolled_win,$name)=@_;
645 
        my $ha= $scrolled_win->get_hadjustment();
646 
    my $va =$scrolled_win->get_vadjustment();
647 
    return if(!defined $ha);
648 
    return if(!defined $va);
649 
    save_adj ($self,$ha,$name,"ha");
650 
        save_adj ($self,$va,$name,"va");
651 
}
652 
 
653 
 
654 
sub load_scrolled_win_adj {
655 
        my ($self,$scrolled_win,$name)=@_;
656 
        my $ha= $scrolled_win->get_hadjustment();
657 
    my $va =$scrolled_win->get_vadjustment();
658 
        my $h=load_adj ($self,$ha,$name,"ha");
659 
        my $v=load_adj ($self,$va,$name,"va");
660 
        #$ha->set_value($h) if(defined $h);
661 
    #$va->set_value($v) if(defined $v);
662 
}
663 
 
664 
 
665 
 
666 
 
667 
sub save_adj {
668 
        my ($self,$adjustment,$at1,$at2)=@_;
669 
        my $value = $adjustment->value;
670 
        $self->object_add_attribute($at1,$at2,$value);
671 
}
672 
 
673 
 
674 
sub load_adj {
675 
        my ($self,$adjustment,$at1,$at2)=@_;
676 
        return if(!defined $at1);
677 
    my $value=  $self->object_get_attribute($at1,$at2);
678 
    return if(!defined $value);
679 
    my $lower =  $adjustment->lower;
680 
    my $upper = $adjustment->upper - $adjustment->page_size;
681 
    $value=  ($value < $lower || $value > $upper ) ? 0 : $value;
682 
 
683 
    $adjustment->set_value($value);
684 
}
685 
 
686 
 
687 16 alirezamon 
##############
688 
#       box
689 
#############
690 
 
691 
sub def_hbox {
692 
        my( $homogeneous, $spacing)=@_;
693 
        my $box = Gtk2::HBox->new($homogeneous, $spacing);
694 
        $box->set_border_width(2);
695 
        return $box;
696 
}
697 
 
698 
sub def_vbox {
699 
        my $box = Gtk2::VBox->new(FALSE, 0);
700 
        $box->set_border_width(2);
701 
        return $box;
702 
}
703 
 
704 
sub def_pack_hbox{
705 
        my( $homogeneous, $spacing , @box_list)=@_;
706 
        my $box=def_hbox($homogeneous, $spacing);
707 
        foreach my $subbox (@box_list){
708 
                $box->pack_start( $subbox, FALSE, FALSE, 3);
709 
        }
710 
        return $box;
711 
 
712 
 
713 
}
714 
 
715 34 alirezamon 
sub def_pack_vbox{
716 
        my( $homogeneous, $spacing , @box_list)=@_;
717 
        my $box=def_vbox($homogeneous, $spacing);
718 
        foreach my $subbox (@box_list){
719 
                $box->pack_start( $subbox, FALSE, FALSE, 3);
720 
        }
721 
        return $box;
722 16 alirezamon 
 
723 34 alirezamon 
}
724 16 alirezamon 
 
725 34 alirezamon 
 
726 
##########
727 
# Paned
728 
#########
729 
 
730 
 
731 
sub gen_vpaned {
732 
        my ($w1,$loc,$w2) = @_;
733 
        my $vpaned = Gtk2::VPaned -> new;
734 
        my($width,$hight)=max_win_size();
735 
 
736 
 
737 
        $vpaned -> pack1($w1, TRUE, TRUE);
738 
        $vpaned -> set_position ($hight*$loc);
739 
        $vpaned -> pack2($w2, TRUE, TRUE);
740 
 
741 
        return $vpaned;
742 
}
743 
 
744 
 
745 
sub gen_hpaned {
746 
        my ($w1,$loc,$w2) = @_;
747 
        my $hpaned = Gtk2::HPaned -> new;
748 
        my($width,$hight)=max_win_size();
749 
 
750 
 
751 
        $hpaned -> pack1($w1, TRUE, TRUE);
752 
        $hpaned -> set_position ($width*$loc);
753 
        $hpaned -> pack2($w2, TRUE, TRUE);
754 
 
755 
        return $hpaned;
756 
}
757 
 
758 16 alirezamon 
#############
759 
# text_view
760 
############
761 
 
762 
sub create_text {
763 
  my $scrolled_window = Gtk2::ScrolledWindow->new;
764 
  $scrolled_window->set_policy ('automatic', 'automatic');
765 
  $scrolled_window->set_shadow_type ('in');
766 
  my $tview = Gtk2::TextView->new();
767 
  $scrolled_window->add ($tview);
768 
  $tview->show_all;
769 
  # Make it a bit nicer for text.
770 
  $tview->set_wrap_mode ('word');
771 
  $tview->set_pixels_above_lines (2);
772 
  $tview->set_pixels_below_lines (2);
773 38 alirezamon 
 # $scrolled_window->set_placement('bottom_left' );
774 16 alirezamon 
  return ($scrolled_window,$tview);
775 
}
776 
 
777 
 
778 
#################
779 
#       table
780 
################
781 
 
782 
sub def_table{
783 
        my ($row,$col,$homogeneous)=@_;
784 
        my $table = Gtk2::Table->new ($row, $col, $homogeneous);
785 
        $table->set_row_spacings (0);
786 
        $table->set_col_spacings (0);
787 
        return $table;
788 
 
789 
}
790 
 
791 38 alirezamon 
sub attach_widget_to_table {
792 
        my ($table,$row,$label,$inf_bt,$widget,$column)=@_;
793 
        $column = 0 if(!defined $column);
794 
        $column *=4;
795 
        #my $tmp=gen_label_in_left(" ");
796 
        if(defined $label)  {$table->attach  ($label , $column, $column+1,  $row,$row+1,'fill','shrink',2,2);$column++;}
797 
        if(defined $inf_bt) {$table->attach  ($inf_bt , $column, $column+1, $row,$row+1,'fill','shrink',2,2);$column++;}
798 
        if(defined $widget) {$table->attach  ($widget , $column, $column+1, $row,$row+1,'fill','shrink',2,2);$column++;}
799 
        #$table->attach  ($tmp , $column+3, $column+4, $row,$row+1,'fill','shrink',2,2);
800 
}
801 16 alirezamon 
 
802 
 
803 38 alirezamon 
#sub attach_widget_to_table2 {
804 
#       my ($table,$row,$label,$inf_bt,$widget)=@_;
805 
 
806 
#       my $tmp=gen_label_in_left(" ");
807 
#       $table->attach  ($label , 0, 4,  $row,$row+1,'fill','shrink',2,2);
808 
#       $table->attach  ($inf_bt , 4, 5, $row,$row+1,'fill','shrink',2,2);
809 
#       $table->attach  ($widget , 5, 9, $row,$row+1,'fill','shrink',2,2);
810 
#       $table->attach  ($tmp , 9, 10, $row,$row+1,'fill','shrink',2,2);
811 
#}
812 16 alirezamon 
 
813 
 
814 
######
815 
#  state
816 
#####
817 
 
818 
sub def_state{
819 
        my ($initial)=@_;
820 
        my $entry = Gtk2::Entry->new;
821 
        $entry->set_text($initial);
822 
        my $timeout=0;
823 
        my @state= ($entry,$timeout);
824 
        return \@state
825 
 
826 
}
827 
 
828 25 alirezamon 
 
829 
 
830 
 
831 
 
832 
sub set_gui_status{
833 
        my ($object,$status,$timeout)=@_;
834 
        $object->object_add_attribute('gui_status','status',$status);
835 
        $object->object_add_attribute('gui_status','timeout',$timeout);
836 16 alirezamon 
}
837 
 
838 
 
839 25 alirezamon 
sub get_gui_status{
840 
        my ($object)=@_;
841 
        my $status= $object->object_get_attribute('gui_status','status');
842 
        my $timeout=$object->object_get_attribute('gui_status','timeout');
843 
        return ($status,$timeout);
844 16 alirezamon 
}
845 
 
846 
 
847 
 
848 
##################
849 
#       show_info
850 
##################
851 
sub show_info{
852 
        my ($textview_ref,$info)=@_;
853 
        my $buffer = $$textview_ref->get_buffer();
854 
        $buffer->set_text($info);
855 
}
856 
 
857 25 alirezamon 
sub add_info{
858 
        my ($textview_ref,$info)=@_;
859 
        my $buffer = $$textview_ref->get_buffer();
860 
        my $textiter = $buffer->get_end_iter();
861 
        #Insert some text into the buffer
862 
        $buffer->insert($textiter,$info);
863 
 
864 
}
865 16 alirezamon 
 
866 38 alirezamon 
 
867 
sub new_on_textview{
868 
        my ($textview,$info)=@_;
869 
        my $buffer = $textview->get_buffer();
870 
        $buffer->set_text($info);
871 
}
872 
 
873 
sub append_to_textview{
874 
        my ($textview,$info)=@_;
875 
        my $buffer = $textview->get_buffer();
876 
        my $textiter = $buffer->get_end_iter();
877 
        #Insert some text into the buffer
878 
        $buffer->insert($textiter,$info);
879 
 
880 
 
881 
}
882 
 
883 
 
884 34 alirezamon 
sub show_colored_info{
885 
        my ($textview_ref,$info,$color)=@_;
886 
        my $buffer = $$textview_ref->get_buffer();
887 
        #$buffer->set_text($info);
888 
        my $textiter = $buffer->get_start_iter();
889 
        $buffer->insert_with_tags_by_name ($textiter, "$info", "${color}_tag");
890 
}
891 16 alirezamon 
 
892 34 alirezamon 
sub add_colored_info{
893 
        my ($textview_ref,$info,$color)=@_;
894 
        my $buffer = $$textview_ref->get_buffer();
895 
        my $textiter = $buffer->get_end_iter();
896 
        #Insert some text into the buffer
897 
        #$buffer->insert($textiter,$info);
898 
        $buffer->insert_with_tags_by_name ($textiter, "$info", "${color}_tag");
899 
 
900 
}
901 25 alirezamon 
 
902 38 alirezamon 
sub add_colors_to_textview{
903 
        my $tview= shift;
904 
        add_colored_tag($tview,'red');
905 
        add_colored_tag($tview,'blue');
906 
        add_colored_tag($tview,'green');
907 
}
908 
 
909 
 
910 34 alirezamon 
sub add_colored_tag{
911 
        my ($textview_ref,$color)=@_;
912 
        my $buffer = $textview_ref->get_buffer();
913 
        $buffer->create_tag ("${color}_tag", foreground => $color);
914 
}
915 
 
916 
 
917 
 
918 16 alirezamon 
####################
919 34 alirezamon 
#        file
920 16 alirezamon 
##################
921 
 
922 
 
923 34 alirezamon 
sub read_verilog_file{
924 16 alirezamon 
        my @files            = @_;
925 
        my %cmd_line_defines = ();
926 
        my $quiet            = 1;
927 
        my @inc_dirs         = ();
928 
        my @lib_dirs         = ();
929 
        my @lib_exts         = ();
930 
        my $vdb = rvp->read_verilog(\@files,[],\%cmd_line_defines,
931 
                          $quiet,\@inc_dirs,\@lib_dirs,\@lib_exts);
932 
 
933 
        my @problems = $vdb->get_problems();
934 
        if (@problems) {
935 
            foreach my $problem ($vdb->get_problems()) {
936 
                print STDERR "$problem.\n";
937 
            }
938 
            # die "Warnings parsing files!";
939 
        }
940 
 
941 
        return $vdb;
942 
}
943 
 
944 25 alirezamon 
sub add_color_to_gd{
945 
        foreach (my $i=0;$i<32;$i++ ) {
946 34 alirezamon 
                my ($red,$green,$blue)=get_color($i);
947 
                add_colour("my_color$i"=>[$red>>8,$green>>8,$blue>>8]);
948 25 alirezamon 
 
949 34 alirezamon 
        }
950 
}
951 
 
952 
 
953 
 
954 
sub append_text_to_file {
955 
        my  ($file_path,$text)=@_;
956 41 alirezamon 
        open(my $fd, ">>$file_path") or die "could not open $file_path: $!";
957 34 alirezamon 
        print $fd $text;
958 
        close $fd;
959 
}
960 
 
961 
 
962 
 
963 
 
964 
sub save_file {
965 
        my  ($file_path,$text)=@_;
966 38 alirezamon 
        open my $fd, ">$file_path" or die "could not open $file_path: $!";
967 34 alirezamon 
        print $fd $text;
968 
        close $fd;
969 
}
970 
 
971 
sub load_file {
972 
        my $file_path=shift;
973 
        my $str;
974 
        if (-f "$file_path") {
975 
 
976 
                $str = do {
977 
                        local $/ = undef;
978 
                        open my $fh, "<", $file_path
979 
                        or die "could not open $file_path: $!";
980 
                        <$fh>;
981 
                };
982 
 
983 25 alirezamon 
        }
984 34 alirezamon 
        return $str;
985 25 alirezamon 
}
986 16 alirezamon 
 
987 25 alirezamon 
 
988 34 alirezamon 
 
989 
 
990 
sub merg_files {
991 
        my  ($source_file_path,$dest_file_path)=@_;
992 
        local $/=undef;
993 
        open FILE, $source_file_path or die "Couldn't open file: $!";
994 
        my $string = <FILE>;
995 
        close FILE;
996 
         append_text_to_file ($dest_file_path,$string);
997 
}
998 
 
999 
 
1000 
 
1001 
sub copy_file_and_folders{
1002 
        my ($file_ref,$project_dir,$target_dir)=@_;
1003 
 
1004 
        foreach my $f(@{$file_ref}){
1005 
                my $name= basename($f);
1006 
                my $n="$project_dir$f";
1007 
                if (-f "$n") { #copy file
1008 
                        copy ("$n","$target_dir");
1009 
                }elsif(-f "$f" ){
1010 
                        copy ("$f","$target_dir");
1011 
                }elsif (-d "$n") {#copy folder
1012 
                        dircopy ("$n","$target_dir/$name");
1013 
                }elsif(-d "$f" ){
1014 
                        dircopy ("$f","$target_dir/$name");
1015 
 
1016 
                }
1017 
        }
1018 
 
1019 
}
1020 
 
1021 
sub read_file_cntent {
1022 
        my ($f,$project_dir)=@_;
1023 
        my $n="$project_dir$f";
1024 
        my $str;
1025 
        if (-f "$n") {
1026 
 
1027 
                $str = do {
1028 
                        local $/ = undef;
1029 
                        open my $fh, "<", $n
1030 
                        or die "could not open $n: $!";
1031 
                        <$fh>;
1032 
                };
1033 
 
1034 
        }elsif(-f "$f" ){
1035 
                $str = do {
1036 
                        local $/ = undef;
1037 
                        open my $fh, "<", $f
1038 
                        or die "could not open $f: $!";
1039 
                        <$fh>;
1040 
                };
1041 
 
1042 
 
1043 
        }
1044 
        return $str;
1045 
 
1046 
}
1047 
 
1048 
 
1049 
sub check_file_has_string {
1050 
    my ($file,$string)=@_;
1051 
    my $r;
1052 
    open(FILE,$file);
1053 
    if (grep{/$string/} <FILE>){
1054 
       $r= 1; #print "word  found\n";
1055 
    }else{
1056 
       $r= 0; #print "word not found\n";
1057 
    }
1058 
    close FILE;
1059 
    return $r;
1060 
}
1061 
 
1062 
 
1063 
###########
1064 
#  color
1065 
#########
1066 
 
1067 
 
1068 
 
1069 
 
1070 
 
1071 25 alirezamon 
 
1072 16 alirezamon 
sub get_color {
1073 
        my $num=shift;
1074 
 
1075 
        my @colors=(
1076 
        0x6495ED,#Cornflower Blue
1077 
        0xFAEBD7,#Antiquewhite
1078 
        0xC71585,#Violet Red
1079 25 alirezamon 
        0xC0C0C0,#silver
1080 16 alirezamon 
        0xADD8E6,#Lightblue
1081 
        0x6A5ACD,#Slate Blue
1082 
        0x00CED1,#Dark Turquoise
1083 
        0x008080,#Teal
1084 
        0x2E8B57,#SeaGreen
1085 
        0xFFB6C1,#Light Pink
1086 
        0x008000,#Green
1087 
        0xFF0000,#red
1088 
        0x808080,#Gray
1089 
        0x808000,#Olive
1090 
        0xFF69B4,#Hot Pink
1091 
        0xFFD700,#Gold
1092 
        0xDAA520,#Goldenrod
1093 
        0xFFA500,#Orange
1094 
        0x32CD32,#LimeGreen
1095 
        0x0000FF,#Blue
1096 
        0xFF8C00,#DarkOrange
1097 
        0xA0522D,#Sienna
1098 
        0xFF6347,#Tomato
1099 
        0x0000CD,#Medium Blue
1100 
        0xFF4500,#OrangeRed
1101 
        0xDC143C,#Crimson
1102 
        0x9932CC,#Dark Orchid
1103 
        0x800000,#marron
1104 
        0x800080,#Purple
1105 
        0x4B0082,#Indigo
1106 25 alirezamon 
        0xFFFFFF,#white
1107 
        0x000000 #Black
1108 16 alirezamon 
                );
1109 
 
1110 
        my $color=      ($num< scalar (@colors))? $colors[$num]: 0xFFFFFF;
1111 
        my $red=        ($color & 0xFF0000) >> 8;
1112 
        my $green=      ($color & 0x00FF00);
1113 
        my $blue=       ($color & 0x0000FF) << 8;
1114 
 
1115 
        return ($red,$green,$blue);
1116 
 
1117 
}
1118 
 
1119 
 
1120 34 alirezamon 
sub get_color_hex_string {
1121 
        my $num=shift;
1122 
 
1123 
        my @colors=(
1124 
        "6495ED",#Cornflower Blue
1125 
        "FAEBD7",#Antiquewhite
1126 
        "C71585",#Violet Red
1127 
        "C0C0C0",#silver
1128 
        "ADD8E6",#Lightblue
1129 
        "6A5ACD",#Slate Blue
1130 
        "00CED1",#Dark Turquoise
1131 
        "008080",#Teal
1132 
        "2E8B57",#SeaGreen
1133 
        "FFB6C1",#Light Pink
1134 
        "008000",#Green
1135 
        "FF0000",#red
1136 
        "808080",#Gray
1137 
        "808000",#Olive
1138 
        "FF69B4",#Hot Pink
1139 
        "FFD700",#Gold
1140 
        "DAA520",#Goldenrod
1141 
        "FFA500",#Orange
1142 
        "32CD32",#LimeGreen
1143 
        "0000FF",#Blue
1144 
        "FF8C00",#DarkOrange
1145 
        "A0522D",#Sienna
1146 
        "FF6347",#Tomato
1147 
        "0000CD",#Medium Blue
1148 
        "FF4500",#OrangeRed
1149 
        "DC143C",#Crimson
1150 
        "9932CC",#Dark Orchid
1151 
        "800000",#marron
1152 
        "800080",#Purple
1153 
        "4B0082",#Indigo
1154 
        "FFFFFF",#white
1155 
        "000000" #Black
1156 
                );
1157 
 
1158 
        my $color=      ($num< scalar (@colors))? $colors[$num]: "FFFFFF";
1159 
        return $color;
1160 
 
1161 
}
1162 16 alirezamon 
 
1163 
 
1164 34 alirezamon 
 
1165 16 alirezamon 
##############
1166 
#  clone_obj
1167 
#############
1168 
 
1169 
sub clone_obj{
1170 
        my ($self,$clone)=@_;
1171 
 
1172 
        foreach my $p (keys %$self){
1173 
                delete ($self->{$p});
1174 
        }
1175 
        foreach my $p (keys %$clone){
1176 
                $self->{$p}= $clone->{$p};
1177 
                my $ref= ref ($clone->{$p});
1178 
                if( $ref eq 'HASH' ){
1179 
 
1180 
                        foreach my $q (keys %{$clone->{$p}}){
1181 
                                $self->{$p}{$q}= $clone->{$p}{$q};
1182 
                                my $ref= ref ($self->{$p}{$q});
1183 
                                if( $ref eq 'HASH' ){
1184 
 
1185 
                                        foreach my $z (keys %{$clone->{$p}{$q}}){
1186 
                                                $self->{$p}{$q}{$z}= $clone->{$p}{$q}{$z};
1187 
                                                my $ref= ref ($self->{$p}{$q}{$z});
1188 
                                                if( $ref eq 'HASH' ){
1189 
 
1190 38 alirezamon 
                                                        foreach my $w (keys %{$clone->{$p}{$q}{$z}}){
1191 16 alirezamon 
                                                                $self->{$p}{$q}{$z}{$w}= $clone->{$p}{$q}{$z}{$w};
1192 
                                                                my $ref= ref ($self->{$p}{$q}{$z}{$w});
1193 
                                                                if( $ref eq 'HASH' ){
1194 
 
1195 
 
1196 38 alirezamon 
                                                                        foreach my $m (keys %{$clone->{$p}{$q}{$z}{$w}}){
1197 16 alirezamon 
                                                                                $self->{$p}{$q}{$z}{$w}{$m}= $clone->{$p}{$q}{$z}{$w}{$m};
1198 
                                                                                my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m});
1199 
                                                                                if( $ref eq 'HASH' ){
1200 
 
1201 38 alirezamon 
                                                                                        foreach my $n (keys %{$clone->{$p}{$q}{$z}{$w}{$m}}){
1202 16 alirezamon 
                                                                                                $self->{$p}{$q}{$z}{$w}{$m}{$n}= $clone->{$p}{$q}{$z}{$w}{$m}{$n};
1203 
                                                                                                my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m}{$n});
1204 
                                                                                                if( $ref eq 'HASH' ){
1205 
 
1206 38 alirezamon 
                                                                                                        foreach my $l (keys %{$clone->{$p}{$q}{$z}{$w}{$m}{$n}}){
1207 16 alirezamon 
                                                                                                                $self->{$p}{$q}{$z}{$w}{$m}{$n}{$l}= $clone->{$p}{$q}{$z}{$w}{$m}{$n}{$l};
1208 
                                                                                                                my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m}{$n}{$l});
1209 
                                                                                                                if( $ref eq 'HASH' ){
1210 
                                                                                                                }
1211 
                                                                                                        }
1212 
 
1213 
                                                                                                }#if
1214 
                                                                                        }#n
1215 
                                                                                }#if
1216 
                                                                        }#m
1217 
                                                                }#if
1218 
                                                        }#w
1219 
                                                }#if
1220 
                                        }#z
1221 
                                }#if
1222 
                        }#q
1223 
                }#if
1224 
        }#p
1225 
}#sub
1226 
 
1227 
 
1228 25 alirezamon 
############
1229 
#       get file folder list
1230 
###########
1231 
 
1232 
sub get_directory_name {
1233 
        my ($object,$title,$entry,$attribute1,$attribute2,$status,$timeout)= @_;
1234 
        my $browse= def_image_button("icons/browse.png");
1235 
 
1236 
        $browse->signal_connect("clicked"=> sub{
1237 
                my $entry_ref=$_[1];
1238 
                my $file;
1239 
                $title ='select directory' if(!defined $title);
1240 
                my $dialog = Gtk2::FileChooserDialog->new(
1241 
                        $title, undef,
1242 
                        #               'open',
1243 
                        'select-folder',
1244 
                        'gtk-cancel' => 'cancel',
1245 
                        'gtk-ok'     => 'ok',
1246 
                        );
1247 
 
1248 
 
1249 
                        if ( "ok" eq $dialog->run ) {
1250 
                        $file = $dialog->get_filename;
1251 
                                $$entry_ref->set_text($file);
1252 
                                $object->object_add_attribute($attribute1,$attribute2,$file);
1253 
                                set_gui_status($object,$status,$timeout) if(defined $status);
1254 
                                #check_input_file($file,$socgen,$soc_state,$info);
1255 
                                #print "file = $file\n";
1256 
                         }
1257 
                        $dialog->destroy;
1258 
 
1259 
 
1260 
 
1261 
                } , \$entry);
1262 
 
1263 
        return $browse;
1264 
 
1265 
}
1266 
 
1267 41 alirezamon 
sub get_project_dir{ #mpsoc directory address
1268 
        my $dir = Cwd::getcwd();
1269 
        my $project_dir   = abs_path("$dir/../../");
1270 
        return $project_dir;
1271 
}
1272 
 
1273 
 
1274 38 alirezamon 
sub remove_project_dir_from_addr{
1275 41 alirezamon 
        my $file=shift;
1276 
        my $project_dir   = get_project_dir();
1277 38 alirezamon 
        $file =~ s/$project_dir//;
1278 
        return $file;
1279 
}
1280 25 alirezamon 
 
1281 38 alirezamon 
sub add_project_dir_to_addr{
1282 
        my $file=shift;
1283 41 alirezamon 
        my $project_dir   = get_project_dir();
1284 38 alirezamon 
        return $file if(-f $file );
1285 
        return "$project_dir/$file";
1286 
 
1287 
}
1288 
 
1289 25 alirezamon 
sub get_file_name {
1290 
        my ($object,$title,$entry,$attribute1,$attribute2,$extension,$lable,$open_in)= @_;
1291 
        my $browse= def_image_button("icons/browse.png");
1292 38 alirezamon 
 
1293 25 alirezamon 
        $browse->signal_connect("clicked"=> sub{
1294 
                my $entry_ref=$_[1];
1295 
                my $file;
1296 
                $title ='select directory' if(!defined $title);
1297 
                my $dialog = Gtk2::FileChooserDialog->new(
1298 
                'Select a File', undef,
1299 
                'open',
1300 
                'gtk-cancel' => 'cancel',
1301 
                'gtk-ok'     => 'ok',
1302 
                );
1303 
         if(defined $extension){
1304 
                my $filter = Gtk2::FileFilter->new();
1305 
                $filter->set_name($extension);
1306 
                $filter->add_pattern("*.$extension");
1307 
                $dialog->add_filter ($filter);
1308 
         }
1309 
          if(defined  $open_in){
1310 
                $dialog->set_current_folder ($open_in);
1311 
                # print "$open_in\n";
1312 
 
1313 
        }
1314 
 
1315 
                        if ( "ok" eq $dialog->run ) {
1316 38 alirezamon 
                        $file = $dialog->get_filename;
1317 34 alirezamon 
                                #remove $project_dir form beginig of each file
1318 38 alirezamon 
                $file =remove_project_dir_from_addr($file);
1319 25 alirezamon 
                                $$entry_ref->set_text($file);
1320 34 alirezamon 
                                $object->object_add_attribute($attribute1,$attribute2,$file) if(defined $object);
1321 25 alirezamon 
                                my ($name,$path,$suffix) = fileparse("$file",qr"\..[^.]*$");
1322 34 alirezamon 
                                if(defined $lable){
1323 
                                        $lable->set_markup("<span  foreground= 'black' ><b>$name$suffix</b></span>");
1324 
                                        $lable->show;
1325 
                                }
1326 25 alirezamon 
 
1327 
                                #check_input_file($file,$socgen,$soc_state,$info);
1328 
                                #print "file = $file\n";
1329 
                         }
1330 
                        $dialog->destroy;
1331 
 
1332 
 
1333 
 
1334 
                } , \$entry);
1335 
 
1336 
        return $browse;
1337 
 
1338 
}
1339 
 
1340 
 
1341 
#################
1342 
#       widget update object
1343 
#################
1344 
 
1345 
sub gen_entry_object {
1346 
        my ($object,$attribute1,$attribute2,$default,$status,$timeout)=@_;
1347 
        my $old=$object->object_get_attribute($attribute1,$attribute2);
1348 
        my $widget;
1349 
        if(defined $old ){
1350 
                $widget=gen_entry($old);
1351 
        }
1352 
        else
1353 
        {
1354 
                $widget=gen_entry($default);
1355 
                $object->object_add_attribute($attribute1,$attribute2,$default);
1356 
        }
1357 
        $widget-> signal_connect("changed" => sub{
1358 
                my $new_param_value=$widget->get_text();
1359 
                $object->object_add_attribute($attribute1,$attribute2,$new_param_value);
1360 
                set_gui_status($object,$status,$timeout) if (defined $status);
1361 
        });
1362 
        return $widget;
1363 
}
1364 
 
1365 
 
1366 
sub gen_combobox_object {
1367 
        my ($object,$attribute1,$attribute2,$content,$default,$status,$timeout)=@_;
1368 
        my @combo_list=split(",",$content);
1369 
        my $value=$object->object_get_attribute($attribute1,$attribute2);
1370 
        my $pos;
1371 
        $pos=get_pos($value, @combo_list) if (defined $value);
1372 
        if(!defined $pos && defined $default){
1373 
                $object->object_add_attribute($attribute1,$attribute2,$default);
1374 
                $pos=get_item_pos($default, @combo_list);
1375 
        }
1376 
        #print " my $pos=get_item_pos($value, @combo_list);\n";
1377 
        my $widget=gen_combo(\@combo_list, $pos);
1378 
        $widget-> signal_connect("changed" => sub{
1379 
                my $new_param_value=$widget->get_active_text();
1380 
                $object->object_add_attribute($attribute1,$attribute2,$new_param_value);
1381 
                set_gui_status($object,$status,$timeout) if (defined $status);
1382 
         });
1383 
        return $widget;
1384 
 
1385 
 
1386 
}
1387 
 
1388 
 
1389 
sub gen_comboentry_object {
1390 
        my ($object,$attribute1,$attribute2,$content,$default,$status,$timeout)=@_;
1391 
        my @combo_list=split(",",$content);
1392 
        my $value=$object->object_get_attribute($attribute1,$attribute2);
1393 
        my $pos;
1394 
        $pos=get_pos($value, @combo_list) if (defined $value);
1395 
        if(!defined $pos && defined $default){
1396 
                $object->object_add_attribute($attribute1,$attribute2,$default);
1397 
                $pos=get_item_pos($default, @combo_list);
1398 
        }
1399 
        #print " my $pos=get_item_pos($value, @combo_list);\n";
1400 
        my $widget=gen_combo_entry(\@combo_list, $pos);
1401 
        ($widget->child)->signal_connect('changed' => sub {
1402 
                my ($entry) = @_;
1403 
                my $new_param_value=$entry->get_text();
1404 
                $object->object_add_attribute($attribute1,$attribute2,$new_param_value);
1405 
                set_gui_status($object,$status,$timeout) if (defined $status);
1406 
         });
1407 
        return $widget;
1408 
 
1409 
}
1410 
 
1411 
 
1412 
 
1413 
sub gen_spin_object {
1414 
        my ($object,$attribute1,$attribute2,$content, $default,$status,$timeout)=@_;
1415 
        my $value=$object->object_get_attribute($attribute1,$attribute2);
1416 
        my ($min,$max,$step)=split(",",$content);
1417 
        if(!defined $value){
1418 
                $value=$default;
1419 
                $object->object_add_attribute($attribute1,$attribute2,$value);
1420 
        }
1421 38 alirezamon 
 
1422 
        $value=~ s/[^0-9.]//g;
1423 
        $min=~   s/[^0-9.]//g;
1424 
        $max=~   s/[^0-9.]//g;
1425 
        $step=~  s/[^0-9.]//g;
1426 
 
1427 
 
1428 25 alirezamon 
        my $widget=gen_spin($min,$max,$step);
1429 
        $widget->set_value($value);
1430 
        $widget-> signal_connect("value_changed" => sub{
1431 38 alirezamon 
                my $new_param_value=$widget->get_value();
1432 25 alirezamon 
                $object->object_add_attribute($attribute1,$attribute2,$new_param_value);
1433 
                set_gui_status($object,$status,$timeout) if (defined $status);
1434 
        });
1435 
        return $widget;
1436 
}
1437 
 
1438 
 
1439 34 alirezamon 
sub gen_check_box_object_array {
1440 
                my ($object,$attribute1,$attribute2,$content,$default,$status,$timeout)=@_;
1441 
                my $value=$object->object_get_attribute($attribute1,$attribute2);
1442 
                $value = $default if (!defined $value);
1443 25 alirezamon 
                my $widget = def_hbox(FALSE,0);
1444 
                my @check;
1445 
                for (my $i=0;$i<$content;$i++){
1446 
                        $check[$i]= Gtk2::CheckButton->new;
1447 
                }
1448 
                for (my $i=0;$i<$content;$i++){
1449 
                        $widget->pack_end(  $check[$i], FALSE, FALSE, 0);
1450 
 
1451 
                        my @chars = split("",$value);
1452 
                        #check if saved value match the size of check box
1453 
                        if($chars[0] ne $content ) {
1454 
                                $object->object_add_attribute($attribute1,$attribute2,$default);
1455 
                                $value=$default;
1456 
                                @chars = split("",$value);
1457 
                        }
1458 
                        #set initial value
1459 
 
1460 
                        #print "\@chars=@chars\n";
1461 
                        for (my $i=0;$i<$content;$i++){
1462 
                                my $loc= (scalar @chars) -($i+1);
1463 
                                        if( $chars[$loc] eq '1') {$check[$i]->set_active(TRUE);}
1464 
                                        else {$check[$i]->set_active(FALSE);}
1465 
                        }
1466 
 
1467 
 
1468 
                        #get new value
1469 
                        $check[$i]-> signal_connect("toggled" => sub{
1470 
                                my $new_val="$content\'b";
1471 
 
1472 
                                for (my $i=$content-1; $i >= 0; $i--){
1473 
                                        if($check[$i]->get_active()) {$new_val="${new_val}1" ;}
1474 
                                        else {$new_val="${new_val}0" ;}
1475 
                                }
1476 
                                $object->object_add_attribute($attribute1,$attribute2,$new_val);
1477 
                                #print "\$new_val=$new_val\n";
1478 
                                set_gui_status($object,$status,$timeout) if (defined $status);
1479 
                        });
1480 
        }
1481 
        return $widget;
1482 
 
1483 
}
1484 
 
1485 
 
1486 
 
1487 34 alirezamon 
 
1488 
 
1489 
sub gen_check_box_object {
1490 
                my ($object,$attribute1,$attribute2,$default,$status,$timeout)=@_;
1491 
                my $value=$object->object_get_attribute($attribute1,$attribute2);
1492 
                if (!defined $value){
1493 
                        #set initial value
1494 
                        $object->object_add_attribute($attribute1,$attribute2,$default);
1495 
                        $value = $default
1496 
                }
1497 
                my $widget = Gtk2::CheckButton->new;
1498 
                if($value == 1) {$widget->set_active(TRUE);}
1499 
                else {$widget->set_active(FALSE);}
1500 
 
1501 
                #get new value
1502 
                $widget-> signal_connect("toggled" => sub{
1503 
                        my $new_val;
1504 
                        if($widget->get_active()) {$new_val=1;}
1505 
                        else {$new_val=0;}
1506 
                        $object->object_add_attribute($attribute1,$attribute2,$new_val);
1507 
                        #print "\$new_val=$new_val\n";
1508 
                        set_gui_status($object,$status,$timeout) if (defined $status);
1509 
                });
1510 
 
1511 
        return $widget;
1512 
 
1513 
}
1514 
 
1515 
 
1516 
 
1517 
 
1518 
 
1519 
 
1520 25 alirezamon 
sub get_dir_in_object {
1521 38 alirezamon 
        my ($object,$attribute1,$attribute2,$content,$status,$timeout,$default)=@_;
1522 25 alirezamon 
        my $widget = def_hbox(FALSE,0);
1523 
        my $value=$object->object_get_attribute($attribute1,$attribute2);
1524 38 alirezamon 
        $object->object_add_attribute($attribute1,$attribute2,  $default) if (!defined $value );
1525 
        $value = $default if (!defined $value );
1526 25 alirezamon 
        my $entry=gen_entry($value);
1527 
        $entry-> signal_connect("changed" => sub{
1528 
                my $new_param_value=$entry->get_text();
1529 
                $object->object_add_attribute($attribute1,$attribute2,$new_param_value);
1530 
                set_gui_status($object,$status,$timeout) if (defined $status);
1531 
        });
1532 
        my $browse= get_directory_name($object,undef,$entry,$attribute1,$attribute2,$status,$timeout);
1533 
        $widget->pack_start( $entry, FALSE, FALSE, 0);
1534 
        $widget->pack_start( $browse, FALSE, FALSE, 0);
1535 
        return $widget;
1536 
}
1537 
 
1538 
 
1539 
 
1540 
 
1541 
sub get_file_name_object {
1542 
        my ($object,$attribute1,$attribute2,$extension,$open_in)=@_;
1543 
        my $widget = def_hbox(FALSE,0);
1544 
        my $value=$object->object_get_attribute($attribute1,$attribute2);
1545 
        my $lable;
1546 
        if(defined $value){
1547 
                my ($name,$path,$suffix) = fileparse("$value",qr"\..[^.]*$");
1548 
                $lable=gen_label_in_center($name.$suffix);
1549 
 
1550 
        } else {
1551 34 alirezamon 
                        $lable=gen_label_in_center("Selecet a file");
1552 32 alirezamon 
                        $lable->set_markup("<span  foreground= 'red' ><b>No file has been selected yet</b></span>");
1553 25 alirezamon 
        }
1554 
        my $entry=gen_entry();
1555 
        my $browse= get_file_name($object,undef,$entry,$attribute1,$attribute2,$extension,$lable,$open_in);
1556 
        $widget->pack_start( $lable, FALSE, FALSE, 0);
1557 
        $widget->pack_start( $browse, FALSE, FALSE, 0);
1558 
        return $widget;
1559 
}
1560 
 
1561 38 alirezamon 
 
1562 
 
1563 
 
1564 
 
1565 
 
1566 
 
1567 
 
1568 
 
1569 
 
1570 
 
1571 
sub add_param_widget {
1572 
         my ($mpsoc,$name,$param, $default,$type,$content,$info, $table,$row,$column,$show,$attribut1,$ref_delay,$new_status,$loc)=@_;
1573 
         my $label;
1574 
         $label =gen_label_in_left(" $name") if(defined $name);
1575 
         my $widget;
1576 
         my $value=$mpsoc->object_get_attribute($attribut1,$param);
1577 
         if(! defined $value) {
1578 
                        $mpsoc->object_add_attribute($attribut1,$param,$default);
1579 
                        $mpsoc->object_add_attribute_order($attribut1,$param);
1580 
                        $value=$default;
1581 
         }
1582 
         if(! defined $new_status){
1583 
                $new_status='ref';
1584 
         }
1585 
         if ($type eq "Entry"){
1586 
                $widget=gen_entry($value);
1587 
                $widget-> signal_connect("changed" => sub{
1588 
                        my $new_param_value=$widget->get_text();
1589 
                        $mpsoc->object_add_attribute($attribut1,$param,$new_param_value);
1590 
                        set_gui_status($mpsoc,$new_status,$ref_delay) if(defined $ref_delay);
1591 
 
1592 
 
1593 
                });
1594 
 
1595 
 
1596 
         }
1597 
         elsif ($type eq "Combo-box"){
1598 
                 my @combo_list=split(",",$content);
1599 
                 my $pos=get_pos($value, @combo_list) if(defined $value);
1600 
                 if(!defined $pos){
1601 
                        $mpsoc->object_add_attribute($attribut1,$param,$default);
1602 
                        $pos=get_item_pos($default, @combo_list) if (defined $default);
1603 
 
1604 
                 }
1605 
                #print " my $pos=get_item_pos($value, @combo_list);\n";
1606 
                 $widget=gen_combo(\@combo_list, $pos);
1607 
                 $widget-> signal_connect("changed" => sub{
1608 
                 my $new_param_value=$widget->get_active_text();
1609 
                 $mpsoc->object_add_attribute($attribut1,$param,$new_param_value);
1610 
                 set_gui_status($mpsoc,$new_status,$ref_delay) if(defined $ref_delay);
1611 
 
1612 
 
1613 
                 });
1614 
 
1615 
         }
1616 
         elsif  ($type eq "Spin-button"){
1617 
                  my ($min,$max,$step)=split(",",$content);
1618 
                  $value=~ s/\D//g;
1619 
                  $min=~ s/\D//g;
1620 
                  $max=~ s/\D//g;
1621 
                  $step=~ s/\D//g;
1622 
                  $widget=gen_spin($min,$max,$step);
1623 
                  $widget->set_value($value);
1624 
                  $widget-> signal_connect("value_changed" => sub{
1625 
                  my $new_param_value=$widget->get_value_as_int();
1626 
                  $mpsoc->object_add_attribute($attribut1,$param,$new_param_value);
1627 
                  set_gui_status($mpsoc,$new_status,$ref_delay) if(defined $ref_delay);
1628 
 
1629 
                  });
1630 
 
1631 
                 # $box=def_label_spin_help_box ($param,$info, $value,$min,$max,$step, 2);
1632 
         }
1633 
 
1634 
        elsif ( $type eq "Check-box"){
1635 
                $widget = def_hbox(FALSE,0);
1636 
                my @check;
1637 
                for (my $i=0;$i<$content;$i++){
1638 
                        $check[$i]= Gtk2::CheckButton->new;
1639 
                }
1640 
                for (my $i=0;$i<$content;$i++){
1641 
                        $widget->pack_end(  $check[$i], FALSE, FALSE, 0);
1642 
 
1643 
                        my @chars = split("",$value);
1644 
                        #check if saved value match the size of check box
1645 
                        if($chars[0] ne $content ) {
1646 
                                $mpsoc->object_add_attribute($attribut1,$param,$default);
1647 
                                $value=$default;
1648 
                                @chars = split("",$value);
1649 
                        }
1650 
                        #set initial value
1651 
 
1652 
                        #print "\@chars=@chars\n";
1653 
                        for (my $i=0;$i<$content;$i++){
1654 
                                my $loc= (scalar @chars) -($i+1);
1655 
                                        if( $chars[$loc] eq '1') {$check[$i]->set_active(TRUE);}
1656 
                                        else {$check[$i]->set_active(FALSE);}
1657 
                        }
1658 
 
1659 
 
1660 
                        #get new value
1661 
                        $check[$i]-> signal_connect("toggled" => sub{
1662 
                                my $new_val="$content\'b";
1663 
 
1664 
                                for (my $i=$content-1; $i >= 0; $i--){
1665 
                                        if($check[$i]->get_active()) {$new_val="${new_val}1" ;}
1666 
                                        else {$new_val="${new_val}0" ;}
1667 
                                }
1668 
                                $mpsoc->object_add_attribute($attribut1,$param,$new_val);
1669 
                                #print "\$new_val=$new_val\n";
1670 
                                set_gui_status($mpsoc,$new_status,$ref_delay) if(defined $ref_delay);
1671 
                        });
1672 
                }
1673 
 
1674 
 
1675 
 
1676 
 
1677 
        }
1678 
        elsif ( $type eq "DIR_path"){
1679 
                        $widget =get_dir_in_object ($mpsoc,$attribut1,$param,$value,'ref',10);
1680 
                        set_gui_status($mpsoc,$new_status,$ref_delay) if(defined $ref_delay);
1681 
        }
1682 
        elsif ( $type eq "FILE_path"){ # use $content as extention
1683 
                        $widget =get_file_name_object ($mpsoc,$attribut1,$param,$content,undef);
1684 
                        set_gui_status($mpsoc,$new_status,$ref_delay) if(defined $ref_delay);
1685 
        }
1686 
 
1687 
        else {
1688 
                 $widget =gen_label_in_left("unsuported widget type!");
1689 
        }
1690 
 
1691 
        my $inf_bt= (defined $info)? gen_button_message ($info,"icons/help.png"):gen_label_in_left(" ");
1692 
        if($show==1){
1693 
                attach_widget_to_table ($table,$row,$label,$inf_bt,$widget,$column);
1694 
                if ($loc eq "vertical"){
1695 
                        #print "$loc\n";
1696 
                         $row ++;}
1697 
                else {
1698 
                        $column+=4;
1699 
                }
1700 
        }
1701 
    return ($row,$column);
1702 
}
1703 
 
1704 
 
1705 
 
1706 
 
1707 16 alirezamon 
################
1708 25 alirezamon 
# ADD info and label to widget
1709 
################
1710 
 
1711 
 
1712 
sub labele_widget_info{
1713 
        my ($label_name,$widget,$info)=@_;
1714 
        my $box = def_hbox(FALSE,0);
1715 
        #label
1716 
        if(defined $label_name){
1717 
                my $label= gen_label_in_left($label_name);
1718 
                $box->pack_start( $label, FALSE, FALSE, 3);
1719 
        }
1720 
        $box->pack_start( $widget, FALSE, FALSE, 3);
1721 
        #info
1722 
        if(defined $info){
1723 
                my $button=def_image_button("icons/help.png");
1724 
                $button->signal_connect("clicked" => sub {message_dialog($info);});
1725 
                $box->pack_start( $button, FALSE, FALSE, 3);
1726 
        }
1727 
        $box->show_all;
1728 
        return $box;
1729 
}
1730 
 
1731 
 
1732 
 
1733 
 
1734 
################
1735 16 alirezamon 
#       general
1736 
#################
1737 
 
1738 
 
1739 
 
1740 
 
1741 
sub  trim { my $s = shift;  $s=~s/[\n]//gs; return $s };
1742 
 
1743 
sub remove_all_white_spaces($)
1744 
{
1745 
  my $string = shift;
1746 
  $string =~ s/\s+//g;
1747 
  return $string;
1748 
}
1749 
 
1750 
 
1751 
 
1752 
 
1753 
sub get_scolar_pos{
1754 
        my ($item,@list)=@_;
1755 
        my $pos;
1756 
        my $i=0;
1757 
        foreach my $c (@list)
1758 
        {
1759 
                if(  $c eq $item) {$pos=$i}
1760 
                $i++;
1761 
        }
1762 
        return $pos;
1763 
}
1764 
 
1765 
sub remove_scolar_from_array{
1766 
        my ($array_ref,$item)=@_;
1767 
        my @array=@{$array_ref};
1768 
        my @new;
1769 
        foreach my $p (@array){
1770 
                if($p ne $item ){
1771 
                        push(@new,$p);
1772 
                }
1773 
        }
1774 
        return @new;
1775 
}
1776 
 
1777 
sub replace_in_array{
1778 
        my ($array_ref,$item1,$item2)=@_;
1779 
        my @array=@{$array_ref};
1780 
        my @new;
1781 
        foreach my $p (@array){
1782 
                if($p eq $item1 ){
1783 
                        push(@new,$item2);
1784 
                }else{
1785 
                        push(@new,$p);
1786 
                }
1787 
        }
1788 
        return @new;
1789 
}
1790 
 
1791 
 
1792 
 
1793 
# return an array of common elemnts between two input arays
1794 
sub get_common_array{
1795 
        my ($a_ref,$b_ref)=@_;
1796 
        my @A=@{$a_ref};
1797 
        my @B=@{$b_ref};
1798 
        my @C;
1799 
        foreach my $p (@A){
1800 38 alirezamon 
                if( grep (/^\Q$p\E$/,@B)){push(@C,$p)};
1801 16 alirezamon 
        }
1802 
        return  @C;
1803 
}
1804 
 
1805 
#a-b
1806 
sub get_diff_array{
1807 
        my ($a_ref,$b_ref)=@_;
1808 
        my @A=@{$a_ref};
1809 
        my @B=@{$b_ref};
1810 
        my @C;
1811 
        foreach my $p (@A){
1812 38 alirezamon 
                if( !grep  (/^\Q$p\E$/,@B)){push(@C,$p)};
1813 16 alirezamon 
        }
1814 
        return  @C;
1815 
 
1816 
}
1817 
 
1818 
 
1819 
 
1820 
sub compress_nums{
1821 
        my      @nums=@_;
1822 
        my @f=sort { $a <=> $b } @nums;
1823 
        my $s;
1824 
        my $ls;
1825 
        my $range=0;
1826 
        my $x;
1827 
 
1828 
 
1829 
        foreach my $p (@f){
1830 
                if(!defined $x) {
1831 
                        $s="$p";
1832 
                        $ls=$p;
1833 
 
1834 
                }
1835 
                else{
1836 
                        if($p-$x>1){ #gap exist
1837 
                                if( $range){
1838 
                                        $s=($x-$ls>1 )? "$s:$x,$p": "$s,$x,$p";
1839 
                                        $ls=$p;
1840 
                                        $range=0;
1841 
                                }else{
1842 
                                $s= "$s,$p";
1843 
                                $ls=$p;
1844 
 
1845 
                                }
1846 
 
1847 
                        }else {$range=1;}
1848 
 
1849 
 
1850 
 
1851 
                }
1852 
 
1853 
                $x=$p
1854 
        }
1855 
        if($range==1){ $s= ($x-$ls>1 )? "$s:$x":  "$s,$x";}
1856 
        #update $s($ls,$hs);
1857 
 
1858 
        return $s;
1859 
 
1860 
}
1861 
 
1862 
 
1863 24 alirezamon 
 
1864 
sub metric_conversion{
1865 
        my $size=shift;
1866 
        my $size_text=  $size==0  ? 'Error':
1867 
                        $size<(1 << 10)? $size:
1868 
                        $size<(1 << 20)? join (' ', ($size>>10,"K")) :
1869 
                        $size<(1 << 30)? join (' ', ($size>>20,"M")) :
1870 
                                         join (' ', ($size>>30,"G")) ;
1871 
return $size_text;
1872 
}
1873 
 
1874 34 alirezamon 
 
1875 
 
1876 
sub check_verilog_identifier_syntax {
1877 
        my $in=shift;
1878 
        my $error=0;
1879 
        my $message='';
1880 
# an Identifiers must begin with an alphabetic character or the underscore character
1881 
        if ($in =~ /^[0-9\$]/){
1882 
                return 'an Identifier must begin with an alphabetic character or the underscore character';
1883 
        }
1884 
 
1885 
 
1886 
#       Identifiers may contain alphabetic characters, numeric characters, the underscore, and the dollar sign (a-z A-Z 0-9 _ $ )
1887 
        if ($in =~ /[^a-zA-Z0-9_\$]+/){
1888 
                 print "use of illegal character after\n" ;
1889 
                 my @w= split /([^a-zA-Z0-9_\$]+)/, $in;
1890 
                 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";
1891 
 
1892 
        }
1893 
 
1894 
 
1895 
# check Verilog reserved words
1896 
        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");
1897 
        if( grep (/^$in$/,@keys)){
1898 
                return  "$in is a Verlig reserved word.";
1899 
        }
1900 
        return undef;
1901 
 
1902 
}
1903 
 
1904 
 
1905 38 alirezamon 
sub capture_number_after {
1906 
        my ($after,$text)=@_;
1907 
        my @q =split  (/$after/,$text);
1908 
        #my $d=$q[1];
1909 
        my @d = split (/[^0-9. ]/,$q[1]);
1910 
        return $d[0];
1911 34 alirezamon 
 
1912 38 alirezamon 
}
1913 34 alirezamon 
 
1914 38 alirezamon 
sub capture_string_between {
1915 
        my ($start,$text,$end)=@_;
1916 
        my @q =split  (/$start/,$text);
1917 
        my @d = split (/$end/,$q[1]);
1918 
        return $d[0];
1919 
}
1920 34 alirezamon 
 
1921 38 alirezamon 
 
1922 41 alirezamon 
sub make_undef_as_string {
1923 
        foreach my $p  (@_){
1924 
                $$p= 'undef' if (! defined $$p);
1925 
 
1926 
        }
1927 
}
1928 
 
1929 
 
1930 16 alirezamon 
1

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.